VBA 中集合的功能比较弱，常见的有数组 (array) 、集合 (Collection）和字典，其中字典是 Key-Value Pair 类型的数据结构，适合按 Key 存储和查找。本篇介绍字典的操作方法。
VBA 语法本身并没有字典这种数据结构，需要引用 Microsft Scripting Runtime 库：
Dictionary 本身的方法不多，只有六个：
From: Dictionary 对象 | Microsoft Docs
创建字典对象并添加值
我们使用前期绑定的方式，new Dictionary() 创建字典对象，Add() 方法添加元素
Public Sub CreateDictionary()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
End Sub
遍历字典
- 通过 Keys 属性遍历
Public Sub IterateThruKeys()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
Dim k As Variant ' 只能为variant或者object类型
For Each k In d.Keys
Debug.Print k, d(k)
Next
End Sub
VBA 表示集合的元素用的也是圆括号，不像其它语言一般用方括号。
- 遍历值
Public Sub IterateThruItems()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
Dim v As Variant
For Each v In d.Items
Debug.Print v
Next
End Sub
- 通过 Count 遍历
Public Sub IterateThruCount()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
Dim i As Integer
For i = 0 To d.Count - 1
Debug.Print d.Keys(i), d.Items(i)
Next
End Sub
下面通过一些小例子加深大家的理解，掌握一些重要的编码方法。
判断 key 是否存在
Public Sub CheckIfExists()
Dim d As New Dictionary
Dim i As Integer
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
If d.Exists("a") Then Debug.Print d("a")
End Sub
将字典的key和value写入工作表
Public Sub WriteToSheet()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
Sheet1.Cells(1, 1).Resize(1, d.Count) = d.Keys
Sheet1.Cells(2, 1).Resize(1, d.Count) = d.Items
End Sub
执行代码后，字典的值被写入到 Sheet1，界面如下：
image
竖向表达感觉会更直观，下面的代码实现列示呈现：
Public Sub WriteToSheet2()
Dim d As New Dictionary
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
Dim i As Integer
For i = 0 To d.Count - 1
Sheet1.Range("A1").Offset(i, 0) = d.Keys(i)
Sheet1.Range("A1").Offset(i, 1) = d.Items(i)
Next
End Sub
效果：
将 Sheet 中的值转换为字典
如果已经有了如上图在 Excel 工作表的值，下面的代码则将这些值转换为字典：
Public Sub ConvertSheetValueToDict()
Dim d As New Dictionary
Dim i As Integer
Dim startCell As Range
Set startCell = Sheet1.Range("A1")
For i = 0 To startCell.CurrentRegion.Rows.Count
d.Add startCell.Offset(i, 0).Value, startCell.Offset(i, 1).Value
Next
Dim k As Variant
For Each k In d.Keys
Debug.Print k, d(k)
Next
End Sub
下面给出两个利用字典进行计算的示例。
利用字典进行求和计算
假设我们有如下的左边数据，要实现按品种进行统计：
Public Sub CalculateUsingDict()
Dim d As New Dictionary
Dim tbl As Range
Dim dataRange As Range
' 不包括表头
Set tbl = Sheet2.Range("A1").CurrentRegion
Set dataRange = tbl.CurrentRegion.Offset(1, 0)
Dim row As Range
Dim cell As Range
Dim key As String
For Each row In dataRange.Rows
key = CStr(row.Cells(1))
If Not d.Exists(key) Then
d.Add key, row.Cells(2)
Else
d(key) = d(key) + row.Cells(2)
End If
Next
Dim k As Variant
Dim i As Integer
For i = 0 To d.Count - 1
Sheet2.Range("H2").Offset(i, 0) = d.Keys(i)
Sheet2.Range("H2").Offset(i, 1) = d.Items(i)
Next
End Sub
这里用到了一个小技巧，因为数据包含表头，所以通过变量 dataRange 只包含数据部分，不包括表头。
通过字典进行匹配
假设有如下图左边的数据，需要实现按姓名查找学生三门课的考试成绩，类似 vlookup。
Public Sub MatchUsingDict()
Dim d As New Dictionary
Dim tbl As Range
Dim dataRange As Range
Set tbl = Sheet3.Range("A1").CurrentRegion
Set dataRange = tbl.CurrentRegion.Offset(1, 0)
Dim row As Range
Dim cell As Range
Dim k As String
Dim v As Variant
For Each row In dataRange.Rows
k = CStr(row.Cells(1))
v = Array(row.Cells(2), row.Cells(3), row.Cells(4))
d.Add k, v
Next
Dim key As String
key = CStr(Sheet3.Range("H2"))
If d.Exists(key) Then
Sheet3.Range("H2").Offset(0, 1) = d(key)(0)
Sheet3.Range("H2").Offset(0, 2) = d(key)(1)
Sheet3.Range("H2").Offset(0, 3) = d(key)(2)
End If
End Sub
有兴趣的小伙伴，甚至可以利用 dictionary 编写类似 vlookup 的函数，自己琢磨吧。
