10 字典¶

一、前言¶

在 Excel VBA 里，只要你做过下面这些事，基本都会遇到 “ 用数组/Range/Collection 写起来很痛苦 ” 的场景：

去重（唯一值列表）
统计次数（词频/客户出现次数/产品销量次数）
快速查找（用一个 key 找到对应 value）
分组聚合（同一客户的多行订单合并/汇总）

如果你还在用 For...Next 双重循环去匹配、用 WorksheetFunction.CountIf 在循环里反复算，速度大概率会炸。Dictionary（字典） 是 VBA 里最接近“哈希表/Map”的结构： 用 Key 快速定位 Value，查找接近 O(1)，并且写法很清晰。需要提一嘴的是：VBA 自带的 Collection 也能勉强用，但 Dictionary 在Exists、Keys、Items、Remove等能力上更完整，写“去重/统计/映射”非常舒服。

二、Dictionary 是什么？能干什么？¶

你可以把 Dictionary 理解为一个“键值对容器”：

Key（键）：唯一标识（如：客户ID、姓名、订单号、SKU）
Value（值）：你想存的东西（数字、字符串、数组、对象、甚至另一个 Dictionary）

它常用来做三类事：

映射查找（ID → 姓名 / SKU → 单价）
计数统计（每个客户出现几次）
分组聚合（客户 → 一组订单行 / 部门 → 员工列表）

字典主要有两种绑定方式，一种是早期绑定，常常写作Dim dict as New Dictionary的形式，一般你在写VBA代码的时候，是不会有Dictionary的智能提示的，如下：

只有在 VBA 编辑器：Tools（工具） → References（引用） → 勾选 “Microsoft Scripting Runtime” 才会有：

Dictionary 来自 Windows 的脚本运行库：Scripting.Dictionary，如果在引用菜单中找不到具体项目，可以尝试在C:\Windows\System32\scrrun.dll路径下找到对应的支持文件，然后再在列表中勾选即可。

另外一种是后期绑定（优缺点：不需要勾引用，兼容性最好，但是没有智能提示），这个当你做好文件发送到另外一台电脑的时候，也能够成功执行，而上面的早期绑定往往只是为了方便代码的编写，晚期绑定常规写法如下：

1 2	`Dim dict As Object Set dict = CreateObject("Scripting.Dictionary")`

三、Dictionary 核心属性/方法一览¶

Add：新增键值对：例如 dict.Add "Tom", 95，但是注意如果 Key 已存在，会报错
Item：读取/修改 value（默认属性），注意 dict("Tom") 等价于 dict.Item("Tom")
1 2
Debug.Print dict("Tom") '读取 dict("Tom") = 100 '修改

Exists：判断 key 是否存在

1
2
3

If dict.Exists("Tom") Then
    '...
End If

Count：元素个数：例如 Debug.Print dict.Count
Remove / RemoveAll：dict.Remove "Tom"（删除单个键值对），dict.RemoveAll（删除所有）
Keys / Items：拿到所有键/值：返回的是 Variant 数组（下标从0开始），不是 Collection
1 2 3
Dim ks, vs ks = dict.Keys vs = dict.Items
CompareMode：键比较模式：指的是大小写敏感/不敏感，必须在 Add 之前设置，否则可能报错或不生效
1 2
dict.CompareMode = vbTextCompare '不区分大小写 'vbBinaryCompare 则区分大小写（默认）

四、关键实战代码片段¶

实战 1：唯一值去重¶

假设数据在 Sheet1!A2:A10000，去重结果输出到 D2 开始，下面这段代码的要点在于用 Exists 保证不重复，同时Keys 一次性输出，避免单元格逐个写入导致慢

Sub UniqueList_ByDictionary()
    Dim ws As Worksheet: Set ws = Sheet1
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '获取A列最后一个非空单元格的行号

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare '不区分大小写去重（可选）

    Dim i As Long, v As String
    For i = 2 To lastRow
        v = Trim$(ws.Cells(i, "A").Value) '这里的$表示Trim函数返回值为字符串类型
        If Len(v) > 0 Then
            If Not dict.Exists(v) Then dict.Add v, 1 '如果字典中不存在该键，则添加该键值对
        End If
    Next i

    '输出 keys 到 D 列
    Dim ks, r As Long
    ks = dict.Keys '获取字典所有键
    ws.Range("D2").Resize(UBound(ks) + 1, 1).Value = Application.Transpose(ks)
End Sub

实战 2：频次统计¶

Sub CountFrequency_ByDictionary()
    Dim ws As Worksheet: Set ws = Sheet1
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary") '创建字典对象,后期绑定
    dict.CompareMode = vbTextCompare '不区分大小写去重（可选）

    Dim i As Long, name As String
    For i = 2 To lastRow
        name = Trim$(ws.Cells(i, "A").Value) '这里的$表示Trim函数返回值为字符串类型
        If Len(name) > 0 Then
            If dict.Exists(name) Then
                dict(name) = dict(name) + 1 '如果字典中存在该键，则将对应的值加1
            Else
                dict.Add name, 1 '如果字典中不存在该键，则添加该键值对
            End If
        End If
    Next i

    '输出到 D:E
    Dim ks, vs, n As Long
    ks = dict.Keys
    vs = dict.Items
    n = dict.Count

    ws.Range("D1:E1").Value = Array("Name", "Count") '设置表头
    ws.Range("D2").Resize(n, 1).Value = Application.Transpose(ks)
    ws.Range("E2").Resize(n, 1).Value = Application.Transpose(vs)
End Sub

如果value不只是一个值，例如不只要拼接订单号，还要：订单数、总金额、最大金额，则可以用数组当 value：value = Array(订单数, 总金额, 最大金额)，这样就可以通过一个键找到多个值了

本期给大家总结了Excel VBA中的常用属性和方法，以供参考