Question

我有一个非常大的excel文件，其中包含员工列表，几列薪水数据，然后是收集数据的财务周。

我正在尝试搜索此数据，并将员工与宏中的特定会计周匹配。我有一个找到名称的解决方案，但不打印财政周，而且非常慢，我确信有更好的方法来完成这个简单的任务。以下是我所拥有的，它非常简单，最后我将需要捕获行中的数据，但是现在我只是打印以获得概念证明。

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

VBA嵌套If / range匹配

1 个答案: