在VBA（Visual Basic for Applications）中，字典（Dictionary）是一种非常实用的对象，它允许我们存储键值对（Key-Value pairs），其中键（Key）是唯一的，而值（Value）可以是任何数据类型。字典在数据处理、数据去重、数据匹配等方面有着广泛的应用。本文将介绍VBA中字典的常见用法，并通过代码示例进行详细解析。

字典（dictionary）是一个储存数据的小仓库。共有两列，第一列叫key , 不允许有重复的元素。第二列是item,每一个key对应一个item，本列允许为重复。如下表所示。

既然有数组，为什么还要学字典？

在VBA中，虽然数组是一个非常强大且基础的数据结构，用于存储和操作一系列相同类型的数据，但在处理复杂数据时，字典（Dictionary）提供了额外的灵活性和效率，这是数组难以直接提供的。以下是几个关键原因：

键值对存储：字典以键值对（Key-Value Pair）的形式存储数据，每个键都是唯一的，与之关联的值可以是任何类型的数据。这种存储方式使得数据检索变得非常快速和直接，因为你可以直接通过键来访问对应的值，而不需要像数组那样通过索引来遍历。

动态集合：与数组相比，字典是动态的。在VBA中，数组的大小一旦在声明时确定（除非使用动态数组并重新分配），就不能轻易改变。而字典则可以在运行时动态地添加、删除或修改键值对，无需担心数据容量的限制。

易于管理和维护：在处理大量相关数据时，字典提供了更清晰的数据结构。每个键都代表了一个特定的标识符或分类，使得数据的管理和维护变得更加直观和方便。

避免数据重复：由于字典的键是唯一的，这有助于避免在数据集中存储重复的值。当你尝试添加一个已存在的键时，字典会覆盖与该键关联的旧值，或者你可以选择不执行任何操作，具体取决于你的需求。

性能优化：在处理大量数据时，字典的查找速度通常比遍历数组要快得多。这是因为字典内部使用了哈希表等高效的数据结构来存储键值对，使得查找操作的时间复杂度接近O(1)。

高级功能：一些字典实现（如VBA中的Scripting.Dictionary）还提供了额外的功能，如Exists方法来检查某个键是否存在于字典中，以及Keys和Items集合来分别获取字典中所有的键和值。

虽然数组是VBA中不可或缺的数据结构，但在处理复杂数据时，字典提供了更高的灵活性和效率。因此，学习如何在VBA中使用字典是非常有价值的。

字典有什么局限？

字典只有两列，如果要处理多列的数据，还需要通过字符串的组合和拆分来实现。字典调用会耗费一定时间，如果是数据量不大，字典的优势就无法体现出来。

字典在哪里？如何创建字典？

在VBA中，创建字典对象通常有两种方式：前期绑定和后期绑定。前期绑定需要在VBA编辑器中引用“Microsoft Scripting Runtime”库，而后期绑定则不需要，但相对来说，后期绑定的代码兼容性更好。

前期绑定：

Dim dict As Dictionary
Set dict = New Dictionary

后期绑定：

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

添加键值对

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

获取值

通过键名来获取对应的值。

Dim value As Variant
value = dict("key1")

删除键值对

使用Remove方法删除字典中的键值对。

dict.Remove "key1"

遍历字典

遍历字典可以通过For Each循环和Keys或Items方法实现。

Dim key As Variant
Dim item As Variant

For Each key In dict.Keys
    item = dict(key)
    ' 在此处处理每个键值对
Next key

例1.字典去重

Sub 字典去重() '去重
    Dim ws As Worksheet
    Dim lastRow,i As Long
    Dim dict As Object
    Dim uniqueValues As Range
    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名称
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 假设数据在A列
    ' 遍历A列，将数据添加到字典中
    For i = 1 To lastRow
        If Not dict.Exists(ws.Cells(i, 1).Value) Then
            dict.Add ws.Cells(i, 1).Value, Nothing ' 这里的Value可以是任何值，因为我们只关心Key的唯一性
        End If
    Next i
    ' 创建一个新的范围来存放去重后的数据
    Set uniqueValues = ws.Range("B1").Resize(dict.Count, 1)
    ' 将去重后的数据写入新的范围
    Dim key As Variant
    i = 1
    For Each key In dict.Keys
        uniqueValues.Cells(i, 1).Value = key
        i = i + 1
    Next key
End Sub

代码说明：

这个例子假设你的数据在Sheet1的A列中。代码遍历A列的每个单元格，将其值作为键添加到字典中。如果键已存在，则不执行任何操作（因为字典不允许重复的键）。去重后的数据被写入到B列，从B1开始。

例2.如何在VBA中使用Scripting.Dictionary对象来存储键值对。

第一列的值作为键（Key），第二列的值作为项（Item），并处理可能出现的重复键错误，最后将所有键和值的信息显示在一个消息框中。代码如下：

Sub t1Optimized()
    ' 声明一个变量D作为Object类型，用于创建Scripting.Dictionary对象
    Dim D As Object
    ' 使用CreateObject函数创建一个Scripting.Dictionary对象实例
    Set D = CreateObject("Scripting.Dictionary")
    ' 声明循环变量x和key变量，以及用于存储最终输出的字符串变量output
    Dim x As Integer
    Dim key As Variant
    Dim output As String
    ' 启用错误处理，如果在添加键时发生错误（如键已存在），则忽略错误
    On Error Resume Next
    ' 循环遍历第2行到第5行的数据，将第一列的值作为键，第二列的值作为项添加到字典D中
    For x = 2 To 5
        D.Add Cells(x, 1).Value, Cells(x, 2).Value
        ' 检查是否有错误发生（如尝试添加已存在的键）
        If Err.Number <> 0 Then
            ' 如果有错误，清除错误状态，以便继续执行循环
            Err.Clear ' 清除错误
        End If
    Next x
    ' 关闭错误处理，让之后的错误能够正常抛出
    On Error GoTo 0
    ' 初始化输出字符串，添加标题信息
    output = "Keys and Items:" & vbCrLf
    ' 遍历字典D中的所有键
    For Each key In D.Keys
        ' 将每个键和对应的项添加到输出字符串中，每个键值对后添加换行符
        output = output & "Key: " & key & ", Item: " & D(key) & vbCrLf
    Next key
    ' 使用MsgBox函数显示包含所有键和项信息的字符串
    MsgBox output
End Sub

例3.运用字典实现按库位和名称汇总数量

Sub 字典求和()
    ' 声明变量
    Dim arr, D As Object, ar
    Dim i As Integer, j As Byte
    ' 创建字典对象
    Set D = CreateObject("Scripting.Dictionary")
    ' 将选定区域的数据装入数组
    arr = Sheet3.Range("a1").CurrentRegion
    ' 循环处理数据
    For i = 1 To UBound(arr)
        ' 将日期和名称拼接成键值
        Dim t As String
        t = arr(i, 1) & "|" & arr(i, 2)
        ' 判断键值是否存在于字典中
        If D.Exists(t) Then
            ' 如果存在，则更新对应销售额
            D(t) = t & "|" & (Val(Split(D(t), "|")(2)) + arr(i, 3))
        Else
            ' 如果不存在，存入"日期|名称|销售额"
            D(t) = t & "|" & arr(i, 3)
        End If
    Next i
    ' 清除原数组数据
    Erase arr
    ' 重新调整数组大小
    ReDim arr(1 To D.Count, 1 To 3)
    ' 获取字典中的值部分
    ar = D.Items
    ' 将数据填充至新数组
    For i = 1 To UBound(ar) + 1
        For j = 1 To 3
            arr(i, j) = Split(ar(i - 1), "|")(j - 1)
        Next j
    Next i
    ' 清除 Sheet4 中的内容
    Sheet4.Range("a1").CurrentRegion.ClearContents
    ' 将处理后的数据输出到 Sheet4
    Sheet4.Range("a1").Resize(UBound(arr), 3) = arr
End Sub