一对多查找是一种普遍的问题。
在vba中如果要实现一对多查找，可以借助字典Dictionary对象。代码如下：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Sub QQ1722187970() Dim oWK As Worksheet Set oWK = Sheet1 '存入结果 '定义字典对象变量 Dim oDic As Object '创建字典对象 Set oDic = CreateObject("Scripting.Dictionary") Dim arrKey Dim arrItem With oWK For i = 2 To .Range("a65536").End(xlUp).Row sID = .Cells(i, "a").Value sValue = .Cells(i, "b").Value With oDic If .exists(sID) Then sTemp = .Item(sID) sTemp = sTemp & "!" & sValue .Item(sID) = sTemp Else .Add sID, sValue End If End With Next i End With '读取结果 Set oWK = Sheet2 With oWK For i = 2 To .Range("a65536").End(xlUp).Row sID = .Cells(i, "a").Value sValue = oDic.Item(sID) arr = Split(sValue, "!") If UBound(arr) Then End If Next i End With '释放字典对象，清空内存 Set oDic = Nothing End Sub |