Сопоставить 2 массива со значениями строк

Question

Я хочу написать код, который использует два 1D-массива и на основе совпадения со значением в строке должен возвращать значение в 3-м массиве.

Вот что я хочу сделать:

В Sheet1 у меня есть 3 столбца с данными об ID, имени и сумме с количеством строк неопределенного размера:

В Sheet2 у меня уже есть столбцы с данными об ID и имени, но у меня нет данных о сумме:

Поэтому я хочу запустить код, который будет сопоставлять массивы с данными идентификатора и имени на листе 1 с данными идентификатора и имени на листе 2, а затем вернуть соответствующие данные суммы на лист 2, как это происходит на листе 1.

Это желаемый результат в Sheet2 после выполнения кода, то есть данные в столбце Amount возвращаются на основе совпадения с массивами по ID и Name в Sheet1:

Это мой код, который не запускается должным образом:

Sub ArrayMatch()

Dim r As Long
Dim d As Long
Dim w_output As Worksheet
Dim w1 As Worksheet
Dim intLastRow As Integer
Dim IntLastCol As Integer
Dim arrName() As Variant
Dim arrID() As Variant
Dim arrrAmoun() As Variant

d = 8

With ThisWorkbook
    Set w1 = .Sheets("Sheet1")
    Set w_output = .Sheets("Sheet2")
End With

'***********************************
'Assign arrays

With w1

    intLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    IntLastCol = .Cells(4, Columns.Count).End(xlToLeft).Column
    arrID = .Range(.Cells(4, 1), .Cells(intLastRow, 1))
    arrName = .Range(.Cells(4, 3), .Cells(intLastRow, 2))
    arrAmoun = .Range(.Cells(4, 4), .Cells(intLastRow, 3))

    For r = 1 To UBound(arrID, 1)
        If Len(arrID(r, 1)) > 0 Then
            d = d + 1
                If w_output.Cells(d, 1) = arrID(r, 1) Then
                    If w_output.Cells(d, 2) = arrName(r, 1) Then
                       w_output.Cells(d, 4) = arrAmoun(r, 1)
                    End If
                End If
        End If
    Next r

End With

End Sub

Мой код ничего не возвращает, я могу предположить, что это потому, что я сравниваю массивы из sheet1 со строками на листе 2, которые не являются сравнительными по размеру, но я не знаю, как это сделать по-другому. Я буду признателен за любую помощь.

Answer 1

Просто изменил ваш код, добавив внутренний цикл для проверки идентификатора и имени в листе w_output (это также можно сделать с помощью Find). Протестировано с временными данными. Однако есть и другие (более эффективные) способы достижения той же цели.

Sub ArrayMatch()

Dim r As Long
Dim d As Long
Dim w_output As Worksheet
Dim w1 As Worksheet
Dim intLastRow As Long            ' Modified to long
Dim IntLastRow1 As Long           ' Modified to long
Dim arrName() As Variant
Dim arrID() As Variant
Dim arrrAmoun() As Variant

'd = 8

With ThisWorkbook
    Set w1 = .Sheets("Sheet1")
    Set w_output = .Sheets("Sheet2")
End With

'***********************************
'Assign arrays

With w1

    intLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    IntLastRow1 = w_output.Cells(Rows.Count, 1).End(xlUp).Row
    arrID = .Range(.Cells(4, 1), .Cells(intLastRow, 1))
    arrName = .Range(.Cells(4, 3), .Cells(intLastRow, 3))
    arrAmoun = .Range(.Cells(4, 4), .Cells(intLastRow, 4))

    For r = 1 To UBound(arrID, 1)
        If Len(arrID(r, 1)) > 0 Then
            For d = 9 To IntLastRow1     ' Modified to for loop for w_output sheet
                If w_output.Cells(d, 1) = arrID(r, 1) Then
                    If w_output.Cells(d, 2) = arrName(r, 1) Then
                    w_output.Cells(d, 4) = arrAmoun(r, 1)
                    Exit For            ' added once found and amount  put in place
                    End If
                End If
            Next
        End If
    Next r

End With

End Sub