2017-07-09 129 views
1

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

同样当我们正常化,我们选择从柱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 
+3

我只想有2列。一个用于工作人员ID,一个用于表示前线或后台的状态。如果您只想看到前线,后台或全部,则可以进行透视或过滤。 –

回答

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 

前后:

BeforeAfter

+0

经过测试和工作很好..非常感谢保罗为你花了这么做的时间来帮助:) –