Excel VBA替換空白值的選擇

Question

我有三列，其中一列擁有所有員工列表ID，第二列擁有前線員工ID，第三列擁有後臺員工ID，有時我們更改任務給他們中的一些人，以在不同的領域工作，所以他的工作人員ID必須從Front-Line col消失並出現在Back-Office col中。和副Versa，這將通過選擇一些列A員工完成，然後它將循環通過列B並刪除選擇值（如果找到），然後將這些選定的單元格添加到列B.

同樣當我們正常化，我們選擇從柱A的一些工作人員，應該刪除色柱B員工的ID，並將其添加到山坳ç

All Staff  |  Front-line   |    Back-Office 


    15348  |   15348    |    15344 
    15347  |   15347    |    15345 
    15345  |      
    15344  |      

我到目前爲止已經取得的成就。

對不起，如果我的代碼看起來有點複雜，那是我知道的唯一方法。

專用按鈕（致力打造第一個山口人員作爲後臺工作）

Dim found As Boolean 
Dim i, j, mycount, dedlist As Integer 
Dim firstempty As Long 
With Sheets("StaffList") 
firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1 
dedlist = .Range("L" & .Rows.Count).End(xlUp).Row 
End With 
mycount = firstempty - 1 
found = False 

    Selection.Copy 
    With Sheets("StaffList") 
     firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1 
     Cells(firstempty, 8).Select 
     Cells(firstempty, 8).PasteSpecial Paste:=xlPasteValues 
    End With 

With Sheets("StaffList") 
firstempty = .Range("H" & .Rows.Count).End(xlUp).Row + 1 
dedlist = .Range("L" & .Rows.Count).End(xlUp).Row 
End With 
mycount = firstempty - 1 

For i = 2 To mycount 

    For j = 2 To dedlist 
    With Sheets("StaffList") 
     If .Range("H" & i).Value = .Range("L" & j).Value Then 
      found = True 

     End If 
    End With 
    Next j 
    If found = False Then 
     dedlist = dedlist + 1 
     With Sheets("StaffList") 
     .Range("L" & dedlist).Value = .Range("H" & i).Value 
     End With 
    End If 
    found = False 

Next i 
' ActiveSheet.Range("$H$1:$H$500").RemoveDuplicates Columns:=1, Header:=xlYes 

Range("A1").Select 

標準化按鈕（正火第二山口人員找回工作作爲一線）

Dim CompareRange As Variant, x As Variant, y As Variant 
Dim rng As Range 
Dim found As Boolean 
Dim i, j, mycount, dedlist As Integer 
Dim firstempty As Long 
With Sheets("StaffList") 
firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1 
dedlist = .Range("H" & .Rows.Count).End(xlUp).Row 
End With 
mycount = firstempty - 1 
found = False 

    Selection.Copy 
    With Sheets("StaffList") 
     firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1 
     Cells(firstempty, 13).Select 
     Cells(firstempty, 13).PasteSpecial Paste:=xlPasteValues 
    End With 

With Sheets("StaffList") 
firstempty = .Range("M" & .Rows.Count).End(xlUp).Row + 1 
dedlist = .Range("H" & .Rows.Count).End(xlUp).Row 
End With 
mycount = firstempty - 1 

For i = 2 To mycount 

    For j = 2 To dedlist 
    With Sheets("StaffList") 
     If .Range("M" & i).Value = .Range("L" & j).Value Then 
      .Range("H" & j).Value = "" 


     End If 
    End With 
    Next j 


Next i 

Range("A1").Select 

Answer 1

這是VBA執行意見如下：

Option Explicit 

Public Sub UpdateStaffTasks() 

    Const FRNT = "Front-line", BACK = "Back-Office" 

    Dim selRow As Variant, lrSelRow As Long, ws As Worksheet, i As Long, j As Long 
    Dim usdRng As Variant, lrUsdRng As Long, red As Long, blu As Long 

    If Selection.Cells.Count = 1 And Selection.Row = 1 Then Exit Sub 
    Set ws = Selection.Parent 
    selRow = GetSelRows(Selection): lrSelRow = UBound(selRow): red = RGB(256, 222, 222) 
    usdRng = ws.UsedRange:   lrUsdRng = UBound(usdRng): blu = RGB(222, 222, 256) 

    For i = 0 To lrSelRow 
     For j = i + 2 To lrUsdRng 
      If j = Val(selRow(i)) Then 
       If Len(usdRng(j, 1)) > 0 And Len(usdRng(j, 2)) > 0 Then 
        usdRng(j, 2) = IIf(usdRng(j, 2) = FRNT, BACK, FRNT) 
        With ws.Cells(j, 1).Resize(, 2).Interior 
         .Color = IIf(usdRng(j, 2) = FRNT, red, blu) 
        End With 
        Exit For 
       End If 
      End If 
     Next 
    Next 
    Selection.Parent.UsedRange = usdRng 
End Sub 

---

Public Function GetSelRows(ByRef selectedRange As Range) As Variant 

    Dim s As Variant, a As Range, r As Range, result As Variant 

    If selectedRange.Cells.Count > 1 Then 
     For Each a In selectedRange.Areas 
      For Each r In a.Rows 
       If r.Row > 1 And InStr(s, r.Row) = 0 Then s = s & r.Row & " " 
      Next 
     Next 
     GetSelRows = Split(RTrim$(s)):   Exit Function 
    Else 
     GetSelRows = Array(selectedRange.Row): Exit Function 
    End If 
End Function 

---

前後：