使用自动过滤器通过VBA在工作表之间匹配数据

Question

我有3张纸：

由以下数据组成的输入表：

Sheet1包含以下数据：

输出应类似于：

我的想法是，宏应该从输入工作表中一个接一个地获取人力资源职位，在 Sheet1 中进行过滤，并找到相应的任务/角色数，然后将其与相应的用户和公司代码一起粘贴到输出工作表中。

到目前为止我的代码：

Private Sub CommandButton1_Click()
With ThisWorkbook.Sheets("Input")
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
End With
cntr = 2
For i = 2 To LastRow
    ThisWorkbook.Worksheets("Output").Cells(cntr, 1).Value = ThisWorkbook.Worksheets("Input").Range("A" & i).Value

    Set Range1 = ThisWorkbook.Worksheets("Input").Range("C" & i)
    With ThisWorkbook.Worksheets("Sheet2")
        .Range("A1").AutoFilter Field:=1, Criteria1:=Range1
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("A2:B").Copy _
        ThisWorkbook.Sheets("Output").Range("C2")

    End With
    cntr = cntr + 1
    Next i
End Sub

我被困住了，因为我无法在“输出”标签中找到如何重复相应的用户和公司代码

Answer 1

除了过滤之外，您还可以使用一些可以帮助您的集合对象，例如scripting.dictionary

我为您的数据创建了一个虚拟版本，如下图所示

an使用此代码在整个J列中生成输出

Sub testing()

Dim rngFirstTable As Excel.Range
Dim rngSecondTable As Excel.Range
Dim dicFilter As New Scripting.Dictionary
Dim dicTasks As Scripting.Dictionary
Dim rngInspect As Excel.Range
Dim lngRowSource As Long
Dim lngRowDest As Long
Dim rngDisplayTopLeft As Range
Dim rngDisplay As Range

lngRowDest = 1

Set rngFirstTable = Range("A1:A4")
Set rngSecondTable = Range("F1:G5")
Set rngDisplayTopLeft = Range("J1")
Set rngDisplay = rngDisplayTopLeft

'   Set dictionary up containing Key's of the HR Roles
For Each rngInspect In rngSecondTable.Columns(1).Cells
    If dicFilter.Exists(rngInspect.value) Then
        dicFilter(rngInspect.value).Add _
            CStr(dicTasks.Count + 1), _
            rngInspect.Offset(0, 1).value
    Else
        Set dicTasks = New Scripting.Dictionary
        dicTasks.Add "1", rngInspect.Offset(0, 1).value
        dicFilter.Add rngInspect.value, dicTasks
    End If
Next rngInspect

For lngRowSource = 2 To rngFirstTable.Rows.Count

    '   Copy the "header info" columns
    rngDisplay.Resize(1, 3).value = rngFirstTable.Cells(lngRowSource, 1).Resize(1, 3).value

    '   Extract the relevant dictionary corresponding to HR Role HR Position
    Set dicTasks = dicFilter(rngFirstTable.Cells(lngRowSource, 3).value)

    '   Use the array from .items() to transpose to array equiv to range
    rngDisplay.Offset(0, 4).Resize(dicTasks.Count, 1).value = _
        Application.Transpose(dicTasks.Items())

    '   Increment the offset from the top left cell
    lngRowDest = lngRowDest + dicTasks.Count
    Set rngDisplay = rngDisplayTopLeft.Offset(lngRowDest - 1, 0)

    Set dicTasks = Nothing

Next lngRowSource

End Sub