VBA字典查找、求和、去重

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