Использование автофильтра для сопоставления данных между листами с использованием VBA

Question

У меня есть 3 листа:

Входной лист, который состоит из следующих данных:

Лист1 состоит из следующих данных:

И вывод должен выглядеть следующим образом:

Моя идея заключается в том, что макрос должен выбрать HR Position из Input sheet по одному, отфильтровать его в 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

Я создал фиктивную версию ваших данных, как показано на рисунке ниже

a использовал этот код для получения результата в столбце 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