二十八讲 VBA字典下

1. 提取唯一值

Sub 提取唯一值()

Dim d As New Dictionary

Dim arr

Dim x As Integer

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

2. 字典与求和

Sub 汇总()

Dim d As New Dictionary

Dim arr, x

arr = Range('d2:e10')

For x = 1 To UBound(arr)

d(arr(x, 1)) = d(arr(x, 1)) arr(x, 2) 'Key对应的item的值在原来的基础上加新的

Next x

Range('f2').Resize(d.Count) = Application.Transpose(d.Keys)

Range('g2').Resize(d.Count) = Application.Transpose(d.items)

End Sub

犯过的错误有：

（1）arr = Range('d2:e10')，这一步自己写代码时候定义为了d2:d10, 错定义为一维数组。

（2）For x = 1 To UBound(arr)，这一步错写为for x = 2 to ubound（arr),错误原因在于混淆了概念

（3）最后一步，d.items,大意写为d,items

3. 多表双向查找

Sub 多表()

Dim d As New Dictionary

Dim x, y

Dim arr

For x = 27 To 29

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