Excel VBA用空值替换选择

I have three columns, one of them having all the staff list IDs, the second is having Front-Line staff IDs, The third is having the Back-office staff IDs, sometimes we change the task to some of them, to work in the different field, So His Staff ID has to disappear from Front-Line col and appear in Back-Office col instead. and Vice-Versa, and this will be done by selecting some of Column A staff, then it will loop through Col B and remove selection value(If found), then add these selected cells to Col B.

我有三个列,其中一个有全体员工ID列表,第二个是让一线员工ID,第三是有后台员工ID,有时我们改变其中的一些任务,工作在不同的领域,所以他的员工ID从前线坳消失,转而出现在后台坳。反之亦然，这将通过选择A列的一些工作人员来完成，然后它将循环遍历Col B并删除选择值(如果找到的话)，然后将这些选定的单元格添加到Col B中。

The same when we normalize, we select some staff from Col A, It should remove the staff IDs from Col B and add it to col C

同样当我们规范化时，我们从Col A中选择一些员工，它应该从Col B中删除员工id并添加到Col C中

All Staff      |       Front-line           |             Back-Office


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

What I've achieved so far.

到目前为止我所取得的成就。

Excuse me if my codes looks a little bit complex, that's the only way I know.

不好意思，如果我的代码看起来有点复杂，这是我知道的唯一方法。

Dedicate Button (Dedicating 1st Col staffs to work as Back-office)

奉献按钮(奉献一名Col员工担任后勤)

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

Normalize Button (Normalizing 2nd Col staffs to get back working as Front-Line)

正常化按钮(使第二上校员工恢复前线工作)

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

1 个解决方案

#1

This is the VBA implementation of the suggestion in comment:

这是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

---

Before and After:

之前和之后: