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
