vba - あるシートから別のシートへの列データを検索し、対応する行データを最初のシートに貼り付ける VBA コード

Question

私は VBA を初めて使用し、問題の解決策を見つけることができません。データを含む 2 つのワークブックがあります。ワークブック1には名前列Aがあります.ワークブック2には名前列Aと列BからDの他のデータもあります.ワークブック1の列Aでワークブック2の列Aから名前を検索する必要があり、名前が一致する場合は対応する行を workbook1 に貼り付けます。また、workbook2 には同じ名前のエントリが複数存在する可能性があることに注意してください。その場合、これらの行の値を連結して workbook1 に貼り付ける必要があります。

助けてください

Dim AVals As New Dictionary Dim k As Long, j As Long, lastRow1 As Long, lastRow2 As Long Dim sh_1, sh_3 As Worksheet Dim MyName As String Dim tmpCollection As Collection Set sh_1 = Sheets("snipe-sample-assets blank") Dimバリアントとしてのキー

inputRowMin = 1
inputRowMax = 288
inputColMin = 1
inputColMax = 9
equipmentCol = 4
dimensionCol = 9

Set equipmentDictionary = CreateObject("Scripting.Dictionary")
equipmentDictionary.CompareMode = vbTextCompare
Set inputSheet = Application.Sheets("Verizon WirelessNumbers_2021033")
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection

For i = 1 To inputRange.Height
    thisEquipment = inputRange(i, equipmentCol).Text
    nextEquipment = inputRange(i + 1, equipmentCol).Text
    thisDimension = inputRange(i, dimensionCol).Text

    'The Strings are equal - add thisEquipment to collection and continue
    If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
        equipmentCollection.Add thisDimension
    'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
    Else
        equipmentCollection.Add thisDimension
        equipmentDictionary.Add thisEquipment, equipmentCollection
        Set equipmentCollection = New Collection
    End If

Next

'Set sh_3 = Sheets("sheet2")

lastRow2 = sh_1.Range("A:A").Rows.Count
lastRow2 = sh_1.Cells(lastRow2, 2).End(xlUp).Row 'last used row in column 2
'MsgBox lastRow2

For j = 2 To lastRow2
    MyName = UCase(sh_1.Cells(j, 2).Value)
    For Each key In equipmentDictionary.Keys
        If (StrComp(MyName, key, vbTextCompare) = 0) Then
            Set tmpCollection = equipmentDictionary.Item(MyName)
            For k = 1 To tmpCollection.Count
                sh_1.Cells(j, 10).Value = tmpCollection.Item(k)
            Next
        End If
        
    Next
    
Next j