VBA字典查找返回多列值

新一一

VBA字典查找返回多列值

新一一

以下代码是返回单列值，如何修改可以返回多列值

Sub myfind()
    Set d1 = CreateObject("scripting.dictionary") '命名字典
    arr = Sheets("商品资料").Range("a2:z" & Sheets("商品资料").Range("b65536").End(3).Row).Value
    brr = Sheets("K3").Range("m2:m" & [m65536].End(3).Row)
    ReDim crr(1 To UBound(brr), 1 To 1)
    For i = 2 To UBound(arr)
        d1(arr(i, 24)) = arr(i, 2)
    Next i
    For y = 1 To UBound(brr)
        crr(y, 1) = d1(brr(y, 1))
    Next y
    Sheets("K3").Range("aa2").Resize(UBound(crr), 1) = crr
End Sub

新一一

如图..................

剑指E

新一一

Sub jik()
Application.ScreenUpdating = False
Dim arr, d As Object, CRR '数组brr用来存放求和数据    '创建字典
Set d = CreateObject("scripting.dictionary")    '数组赋值
'arr = Worksheets("核对").[d1].CurrentRegion    '重置数组brr大小
'brr = Worksheets("汇总").[a1].CurrentRegion
arr = Worksheets("核对").UsedRange    '重置数组brr大小
brr = Worksheets("汇总").UsedRange

For i = 1 To UBound(arr)
  d(arr(i, 4)) = arr(i, 5) & "," & arr(i, 6)
  Next

ReDim CRR(2 To UBound(brr), 1 To 1)
ReDim DRR(2 To UBound(brr), 1 To 1)
For J = 2 To UBound(brr)
   If d(brr(J, 3)) <> "" Then
   CRR(J, 1) = Split(d(brr(J, 3)), ",")(0) '在BRR里查找到此名，并返回对应值
   DRR(J, 1) = Split(d(brr(J, 3)), ",")(1)
   Else
   CRR(J, 1) = ""
   DRR(J, 1) = ""
   End If
   Next
   
   Worksheets("汇总").[d2].Resize(UBound(CRR) - 1, 1) = CRR
   Worksheets("汇总").[e2].Resize(UBound(CRR) - 1, 1) = DRR
  
  
    Set d = Nothing
    Application.ScreenUpdating = True

End Sub

'最后面不是空值的行号：i = Sheets("导出").Range("a65536").End(xlUp).Row

'创建字典1：Set d = CreateObject("scripting.dictionary")

'创建字典2引用法：dim d as new dictionary

'关闭屏幕更新:application.ScreenUpdating=False
'application.ScreenUpdating=true

'错误继续执行：On Error Resume Next

sdytsxd991122

ykcbf1100

d1(arr(i,1))=i   '//获得行号就行了