2

我有一个相当大的 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
4

1 回答 1

0

我在 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
于 2013-06-19T20:30:06.250 回答