Excel中如何使用VBA宏向Scripting.Dictionary插入整列键值对？

Scripting.Dictionary的键唯一性特性非常适配提取唯一键值对、后续遍历做查找替换的需求，相比List可以省去手动去重、匹配键值的步骤，执行效率更高。

前置说明 #

如果希望代码无需提前配置引用即可运行，直接使用下方的晚绑定写法即可；如果需要代码提示，可以在VBA编辑器的「工具」-「引用」中勾选Microsoft Scripting Runtime，将字典声明改为Dim dict As Dictionary即可。

完整实现代码 #

Sub 加载设备信息到字典()
    Dim dict As Object
    Dim lastRow As Long
    Dim i As Long
    ' 可按需修改DeviceGuid和SerialNo对应的列号，下方示例A列为Guid，B列为序列号
    Const GUID_COL As Long = 1
    Const SERIAL_COL As Long = 2
    ' 起始行号，若没有表头则改为1
    Const START_ROW As Long = 2
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    ' 自动获取Guid列最后一行有效行号，适配不固定长度的数据集
    lastRow = Cells(Rows.Count, GUID_COL).End(xlUp).Row
    
    ' 遍历加载数据到字典
    For i = START_ROW To lastRow
        ' 跳过Guid为空的无效行
        If Cells(i, GUID_COL).Value <> "" Then
            ' 键不存在时新增，重复Guid默认保留第一次出现的序列号
            If Not dict.Exists(CStr(Cells(i, GUID_COL).Value)) Then
                dict.Add Key:=CStr(Cells(i, GUID_COL).Value), Item:=CStr(Cells(i, SERIAL_COL).Value)
            End If
            ' 如果需要重复Guid覆盖为最新的序列号，替换上面的判断为下方代码：
            ' dict(CStr(Cells(i, GUID_COL).Value)) = CStr(Cells(i, SERIAL_COL).Value)
        End If
    Next i
    
    ' 下方为遍历字典执行查找替换的示例逻辑，可按需修改替换范围和规则
    Dim guidKey As Variant
    For Each guidKey In dict.Keys
        ' 示例：将C列中匹配Guid的内容替换为对应序列号
        Columns("C:C").Replace What:=guidKey, Replacement:=dict(guidKey), LookAt:=xlWhole
    Next guidKey
    
    ' 释放对象内存
    Set dict = Nothing
End Sub

核心特性说明 #

• 动态适配数据长度：通过End(xlUp)自动识别有效数据边界，不需要手动修改数据范围，适配长度不定的列数据
• 内置去重逻辑：利用字典键的唯一性自动过滤重复键值对，无需额外编写去重代码
• 查询效率更高：字典的键查找时间复杂度为O(1)，相比List遍历匹配做替换的速度提升非常明显，数据量越大优势越显著
• 灵活可配置：列号、起始行、重复键处理规则、替换规则都可以根据实际需求快速调整

内容的提问来源于stack exchange，提问作者skt