二十八讲 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