Sub 多表双向查找()
Dim d As New Dictionary
Dim x, y
Dim arr
For x = 3 To 5
arr = Sheets(x).Range('a2').Resize(Sheets(x).Range('a65536').End(xlUp).Row - 1, 2)
For y = 1 To UBound(arr)
d(arr(y, 1)) = arr(y, 2)
d(arr(y, 2)) = arr(y, 1)
Next y
Next x
MsgBox d('C1')
MsgBox d('张三')
End Sub
Sub 提取不重复()
Dim d As New Dictionary
Dim arr, x
arr = Range('a2:a12')
For x = 1 To UBound(arr)
d(arr(x, 1)) = ''
Next x
Range('c2').Resize(d.Count) = Application.Transpose(d.Keys)
End Sub
Sub 字典求和汇总()
Dim d As New Dictionary
Dim arr, x
arr = Range('a2:b10')
For x = 1 To UBound(arr)
d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) 'key对应的item的值在原来的基础上加新的
Next x
Range('d2').Resize(d.Count) = Application.Transpose(d.Keys)
Range('e2').Resize(d.Count) = Application.Transpose(d.Items)
End Sub
联系客服