VBA嵌套如果/範圍匹配

Question

我有一個非常大的ex​​cel文件，其中包含員工列表，幾列薪水數據，然後分配給收集數據的財政周。

我正在嘗試搜索此數據，並且在宏中與特定會計周的員工進行匹配。我有一個解決方案，可以找到名稱，但不會打印出財政周，而且速度非常緩慢，我確信有更多的方法來完成這項簡單的任務。下面是我所擁有的，它非常簡單，最後我需要捕獲行中的數據，但現在我只是打印以獲得概念證明。

Sub loop_test() 
    Dim ClientTable As Range 
    Dim rng1 As Range, rng2 As Range, desired_emp As String, desired_fw As Integer 

    desired_emp = Application.InputBox("Select an Employee", Type:=8) 
    desired_fw = Application.InputBox("What FW would you like to do this for?", Type:=8) 


    Set FullName = Sheets("Query5").Range("A:A") 
    Set FiscalWeek = Sheets("Query5").Range("F:F") 

    For Each rng1 In FullName.Columns(1).Cells 
     If rng1.Value = desired_emp Then 
      matched_name = rng1.Cells.Value 

      For Each rng2 In FullName.Columns(1).Cells 
       If rng2.Value = desired_fw Then 
        matched_fw = rng2.Cells.Value 
       End If 
      Next 
     End If 
    Next 

    Range("i3").Value = matched_name 
    Range("j3").Value = matched_fw 

End Sub 

Answer 1

我設置了列名和財政周爲例範圍A和B修改下面的代碼以匹配您的工作簿中的列和範圍，並設定目標片的適當位置。

此代碼自動篩選基於用戶輸入和複製的結果到另一個片材的範圍，如果有一個匹配：

Sub Autofilter_test() 
    Dim clientTable As Range 
    Dim desired_emp As String 
    Dim desired_fw As Integer 
    Dim MatchRange As Range 
    Dim tgt As Worksheet 

    Set clientTable = Range("A1:B8") 
    Set tgt = ThisWorkbook.Sheets("Sheet2") 
    ActiveSheet.AutoFilterMode = False 
    desired_emp = Application.InputBox("Select an Employee") 
    desired_fw = Application.InputBox("What FW would you like to do this for?") 

    With clientTable 
     .AutoFilter Field:=1, Criteria1:=desired_emp 
     .AutoFilter Field:=2, Criteria1:=desired_fw 
    End With 

    Call CopyFilteredData(tgt) 

End Sub 


Sub CopyFilteredData(tgt As Worksheet) 
    ' by Tom Ogilvy source: http://www.contextures.com/xlautofilter03.html 
    Dim rng As Range 
    Dim rng2 As Range 

    With ActiveSheet.AutoFilter.Range 
    On Error Resume Next 
     Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _ 
      .SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 
    End With 
    If rng2 Is Nothing Then 
     MsgBox "No data to copy" 
    Else 
     tgt.Cells.Clear 
     Set rng = ActiveSheet.AutoFilter.Range 
     rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _ 
     Destination:=tgt.Range("A1") 
    End If 
     ActiveSheet.ShowAllData 

End Sub