Excel VBA 编程基础学习笔记 · 第六章：字典技术 - 掌握高级数据映射与处理的王牌工具
目录
第6章：VBA与字典技术
1、字典技术的魅力
2、字典语法基础
3、字典实例(第1次与最后一次采购价提取)
4、字典实例（多表求不重复值）
5、字典实例(字典与数组经典结合)
6、字典实例(分类计算)
7、字典应用（多列合并计算）
在掌握了数组带来的“速度革命”之后，你是否曾为这样的问题感到棘手：如何从海量数据中瞬间找出唯一值？如何根据一个关键字快速匹配并汇总对应的信息？当面对多列数据的复杂关联时，仅靠数组的索引似乎力不从心。
本章，我们将解锁VBA中另一个堪称“神器”的核心对象——字典（Dictionary）。它不像数组那样按序号排列，而是构建了一种独特的“键-值”映射关系。正是这种结构，让它天生成为解决数据去重、分类统计、快速查询等难题的“王牌工具”。
简单来说，如果说数组是效率超高的流水线，那么字典就是一张智能的索引地图。无论是要提取客户的末次交易价格，还是合并来自多个表格且不重复的数据，字典都能用极其简洁优雅的代码，轻松实现以往需要复杂循环才能完成的任务。
让我们一起深入探究字典的六大核心方法，学习前期与后期绑定的技巧，并通过“提取首次/末次记录”、“多表合并去重”等经典案例，掌握这把提升数据处理维度与效率的利剑。
第6章：VBA与字典技术
1、字典技术的魅力
字典技术：
1、VBA中的字典（dictionary）,是微软windows脚本语言中的一个很有用的对象
2、VBA字典特点：
KEY的唯一性
KEY与Item的相互对应关系
3、字典有什么用：
字典+数组=更强大
4、字典并不存在于VBA中，需要调用：
调用方法一：引用法（前期绑定）：工具-引用-浏览-找到scrrun.dll-确定（在system32中）
引用对象为：Microsoft Scripting Runtime（此插件打上勾即引用成功）
调用方法二：直接创建法（后期绑定）：
set d=Createobject("scripting.dictionary")
建议写代码时做前期绑定，写完后改成后期绑定
理由：引用法，写代码时有提示；直接创建法在任何一台电脑中都能直接打开使用
Add方法：向dictionary对象中添加一个关键字项目对
语法：object.add(key,item)
object，必选项，是一个字典对象的名称
key，必选项，与被添加的item相关联的key
item，必选项，与被添加的key相关联的item
说明：key是唯一的，否则将导致一个错误
2、字典语法基础
Sub字典测试()
DimdAsNewDictionary
'Set d = CreateObject("scripting.dictionary")
d.Add "张三", "123"
d.Add "李四", "456"
'Keys方法：返回一个数组，其中包含了一个dictionary对象中全部的关键字
i = d.Keys(1)'前期绑定写法。 方法1
j = Application.Index(d.Keys, 2)'方法2
k = d.Keys
l = k(1)'方法3
'以上都是获取keys的第2个值
'items方法：返回一个数组，其中包含了一个dictionary对象中的所有项目
r = d.Items(1)'前期绑定写法。 方法1
s = Application.Index(d.Items, 2)'方法2
t = d("李四")'方法3
w = d.Items
v = w(1)'方法4
'Exists方法：如果dictionary对象中存在所指的关键字则返回true，否则返回false
a = d.Exists("李四")
'remove方法：从一个dictionary对象中清除一个关键字、项目对
d.Remove ("李四")
'removeall方法：从一个dictionary对象中清除所有关键字、项目对
d.RemoveAll
EndSub
'字典对象的方法有6个：
'Add添加一条关键字与条目
'keys返回所有关键字（形成1维数组）
'items返回所有条目（形成1维数组）
'exists关键字是否存在（true/false）
'remove移除关键字与对应的条目
'removeall 移除所有关键字与对应的条目
'字典对象的属性有4个：comparemode属性、count属性、key属性、item属性
Sub字典测试2()
Setd = CreateObject("scripting.dictionary")
'1、comparemode属性:设置或返回dictionary对象中字符串关键字的比较模式：
'1不区分大小写，0 区分大小写
d.CompareMode = 1
d.Add "张三", "123"
d.Add "李四", "456"
d.Add "王五", "789"
'2、count属性：返回dictionary对象中项目数。只读属性
k = d.Count
'3、key属性：在dictionary对象中修改一个key
d.Key("王五") = "孙悟空"
'4、item属性：在dictionary对象中设置或返回所指定key的item
d.Item("张三") = "88888"
d("张三") = 999'简写
'注意：容易混淆知识点：d.key("a") 与 d.item("a")
EndSub
Sub有相同key时跳过()
DimdAsNewDictionary
OnErrorResumeNext'相同key时要么跳过，要么报错
arr = Range("a2:b" & Cells(Rows.Count, 2).End(xlUp).Row)
Fori = 1ToUBound(arr)
d.Add arr(i, 1), arr(i, 2)
Next
i = d.Keys
j = d.Items
'小结：如果有错误后继续执行，只记入第一次写入的key和item
EndSub
Sub修改item值时无相同key则添加否则就修改()
DimdAsNewDictionary
arr = Range("a2:b" & Cells(Rows.Count, 2).End(xlUp).Row)
Fori = 1ToUBound(arr)
j = arr(i, 1)
m = arr(i, 2)
d.Item(j) = m'要修改的关键字（key）没有，就增加到字典中
k = d.Item("牛二")
Next
EndSub
'总结：对字典item值的修改，有key则修改，无key则添加
'这两个特点作用非常大，可以求不重复值，可以做分类汇总
3、字典实例(第1次与最后一次采购价提取)
'实例一：求每种产品第一次采购价
Sub求第一次采购价()
OnErrorResumeNext
Setd = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
Fori = 1ToUBound(arr)
d.Add arr(i, 1), arr(i, 2)
Next
[e1].Resize(d.Count) = Application.Transpose(d.Keys)
[f1].Resize(d.Count) = Application.Transpose(d.Items)
ForEachiInd.Keys'd.Keys和d.Items都是一维数组，直接一个个取出来就是原原本本的数据了
MsgBox i
Next
EndSub
'实例二：求每种产品最后一次采购价
Sub求最后一次采购价()
Setd = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
Fori = 1ToUBound(arr)
d.Item(arr(i, 1)) = arr(i, 2)
Next
[i1].Resize(d.Count) = Application.Transpose(d.Keys)
[j1].Resize(d.Count) = Application.Transpose(d.Items)
EndSub
4、字典实例（多表求不重复值）
'实例：多表求不重复值
Sub多表求不重复值()
Setd = CreateObject("scripting.dictionary")
ForEachShInSheets
c = Sh.Name
Ifc <> "品名"Then
arr = Sh.Range("a1:a" & Sh.Cells(Rows.Count, 1).End(xlUp).Row)
ForEachrngInarr
d(rng) = ""'简写，相当于d.item(rng)=""
Next
EndIf
Next
[a1].Resize(d.Count) = Application.Transpose(d.Keys)
EndSub
5、字典实例(字典与数组经典结合)
'实例:字典与数组的经典结合去除重复词语
Sub去除重复词语()
Setd = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("a1:a" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
ForEachrngInarr
arr1 = VBA.Split(rng, "|")
ForEachrngsInarr1
d(rngs) = ""'相当于d.item(rngs)=""
Next
i = VBA.Join(d.Keys, "|")
n = n + 1
Sheet2.Cells(n, "a") = i
d.RemoveAll
Next
EndSub
6、字典实例(分类计算)
Sub分类计算()
Setd = CreateObject("scripting.dictionary")
arr = Range("n2:n" & Cells(Rows.Count, "n").End(xlUp).Row)
ForEachrngInarr
i = d(rng)'用于观察d(rng) 的值
d(rng) = d(rng) + 1'd(rng)是d.item(rng)的简写
i = d(rng)'用于观察d(rng) 的值
Next
[s2].Resize(d.Count) = Application.Transpose(d.Keys)
[t2].Resize(d.Count) = Application.Transpose(d.Items)
EndSub
Sub分类求和()
Setd = CreateObject("scripting.dictionary")
arr = Range("n2:o" & Cells(Rows.Count, "o").End(xlUp).Row)
Fori = 1ToUBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
'd(arr(i, 1))相当于d.item(arr(i, 1)),它取得的是相应key的item值
Next
[s9].Resize(d.Count) = Application.Transpose(d.Keys)
[t9].Resize(d.Count) = Application.Transpose(d.Items)
EndSub
7、字典应用（多列合并计算）
Sub多列合并计算()
Setd = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, "d").End(xlUp).Row)
Fork = 7To9
Fori = 1ToUBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, k - 5)
Next
Cells(2, 6).Resize(d.Count) = Application.Transpose(d.Keys)
Cells(2, k).Resize(d.Count) = Application.Transpose(d.Items)
d.RemoveAll
Next
EndSub
Sub字典条目数组用法()
Setd = CreateObject("scripting.dictionary")
arr = Sheets("data").Range("a2:e" & Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row)
Fori = 1ToUBound(arr)
d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))'把2到5列的信息放到d.item(arr(i, 1))中
j = d(arr(i, 1))'用于在“本地窗口”查看字典条目的变化
Next
ForEachrngInRange("a3:a" & Cells(Rows.Count, 1).End(xlUp).Row)
rng.Offset(0, 1).Resize(1, 4) = d(rng.Value)'d(rng.Value)是d.item(rng.Value)的简写
Next
EndSub