Question

我有三列，其中一列有所有员工列表ID，第二列有前线员工ID，第三列有后台员工ID，有时我们将任务更改为其中一些，到在不同的领域工作，所以他的员工ID必须从Front-Line col消失并出现在Back-Office col中。和副Versa，这将通过选择一些A列工作人员完成，然后它将循环通过Col B并删除选择值（如果找到），然后将这些选定的单元格添加到Col B.

当我们正常化时，我们从Col A中选择一些员工，它应该从Col B中删除员工ID并将其添加到col C

All Staff      |       Front-line           |             Back-Office


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

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

打扰一下，如果我的代码看起来有点复杂，这是我所知道的唯一方式。

Dedicate Button（致力于第一批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

标准化按钮（规范化第二列人员以恢复作为前线工作）

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

之前和之后：

Excel VBA用空值

1 个答案: