我有两本练习册。在workbook1中有一个名称列A。在workbook2中,还有一个名称列A和从列B到D的其他数据。
我需要从工作簿2的A列中搜索工作簿1的A列中的名称,如果名称匹配,则粘贴工作簿1中的相应行。
请注意,在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 key As Variant
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
1条答案
按热度按时间brqmpdu11#
快速了解您的需求
如果你想为单独的工作簿做这件事,那么你需要分配一个wbName2。我对ActiveWorkbook的使用假设它将在你粘贴的工作簿中运行。它还假定您已打开两个工作簿。你自己能搞清楚的。