VBA字典技术整理
这段时间颇有点邯郸学步的感觉，由于把大量的时间和精力投入到python中，之前学的vba到想用的时候，居然忘了。
作为非程序员，编程向来当成"核导弹"来用，一次编写出来，能用，好，很难再有机会写第二遍代码了，因为问题解决了，以至于一直在遗忘的状态，再想用的时候到处翻资料，笔记。
VBA字典技术
VBA字典在日常统计工作中是个十分有用的技术，但是在写程序时，由于不熟练和个人记忆力有限，总要翻阅资料，于是产生将常用的字典技术汇集起来的想法。
一、入门篇
字典: 是为字词提供音韵、意思解释、例句、用法等等的工具书。
在VBA中字典与传统理解的字典差不多：
1、都具有关键字（key）和值(item)一一对应的关系，
2、键具有唯一性。
VBA字典的作用，与数组的结合运用，简化代码（其实是牺牲内存，空间换取时间的用法，但在现时代通用的电脑普遍内存够用的），提升速度等一些强大的功能。
字典不存在与VBA中，需要调用，有两种方法：
1、前期绑定，在EXCEL表格开发工具中，工具-引用-浏览-找到scrrun.dll-确定；
2、后期绑定，直接用代码创建调用：Set d = CreateObject("scripting.dictionary")
本文主要采用后期绑定方式记录字典用法。
字典对象的方法有6个：
Add 添加一条关键字与条目
Keys 返回所有关键字(形成1维数组)
Items 返回所有条目(形成1维数组)
Exists 关键字是否存在(TRUE/FALSE)
Remove 移除关键字与对应的条目
RemoveAll 移除所有关键字与对应的条目
向 Dictionary 对象中添加一个关键字项目对。
语法：object.Add (key, item)
Key，必选项。与被添加的 item 相关联的 key。
Item，必选项。与被添加的 key 相关联的 item。
key 是唯一存在的，否则将导致一个错误。
实例1:
Sub kaishi()
'字典的键索引从零开始为第一个键
Dim d As New Dictionary, i, j, k, l
Set d = CreateObject("scripting.dictionary")
d.Add "张三", "15"
d.Add "李四", "18"
‘基础取值方法
i = d.Keys(0)
j = Application.WorksheetFunction.Index(d.Keys, 2)
k = d.Keys ’keys会返回一个数组，所以可以用Index方法取值
l = k(1)
'Exists方法
'如果 Dictionary 对象中存在所指定的关键字则返回 true，否则返回 false。
' a = d.Exists("李四")
'Remove方法
'Remove 方法从一个 Dictionary 对象中清除一个键——值对。
d.Remove ("李四")
'RemoveAll方法
'RemoveAll 方法从一个 Dictionary 对象中清除所有键——值对。
d.RemoveAll
End Sub
字典对象的属性有4个：
CompareMode属性
Count属性
Key属性
Item属性
实例2：
Sub test()
Set d = CreateObject("scripting.dictionary")
'1.CompareMode属性
'设置或者返回在 Dictionary 对象中进行字符串关键字比较时所使用的比较模式。
d.CompareMode = 0 '1则不区分大小写，0则区分大小写，默认为1
d.Add "a", ""
d.Add "A", ""
d.Add "张三", "13434544323"
d.Add "李四", "13589898999"
d.Add "王五", "13456565567"
'2.Count属性
'返回一个Dictionary 对象中的项目数.只读属性
k = d.Count
'3.Key属性
'在 Dictionary 对象中修改一个 key。
d.Key("王五") = "牛三斤"
'4.Item属性
'在一个 Dictionary 对象中设置或者返回所指定 key 的 item。对于集合则根据所指定的 key 返回一个 item。
i = d.Items
d.Item("张三") = "112233"
i = d.Items
d("张三") = 987 '简写方式
i = d.Items
'注意：容易混淆知识点。d.key("a")与d("a")
End Sub
二、实战篇
实例3：第一次与最后一次采购价格提取
在VBA中，字典的键具有唯一性，采用add方法，如果有重复的键则会发生错误，根据这一特性，可以提取到第一次出现的键——值对。
而采用d.item(key)=value替换方法，新的键——值对会替换掉之前的键——值对，从而提取到最后一次键——值对。
由于d.keys与d.items都会形成标准的一维数组，在写入纵向的单元格时，需要通过transpose进行转置。
'求每种产品第一次采购价
Sub first()
Dim arr()
On Error Resume Next
Set d = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = 1 To UBound(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)
End Sub
'求每种产品最后一次采购价
Sub last()
Dim arr()
Set d = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = arr(i, 2)
Next
[i1].Resize(d.Count) = Application.Transpose(d.keys)
[j1].Resize(d.Count) = Application.Transpose(d.items)
End Sub
实例4：多表求不重复值
值得一提的是d(key)=value方法，没有就写入，有就替换，而且并不会随着循环的改变清空其中的键——值对。
Sub test()
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
c = sh.Name
If sh.Name <> "品名" Then
arr = sh.Range("a1:a" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
For Each Rng In arr
d(Rng) = ""
Next
End If
Next
[a1].Resize(d.Count) = Application.Transpose(d.keys)
End Sub
实例5：字典与数组的结合运用
Sub test()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1:b" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row)
For Each Rng In arr
arr1 = VBA.Split(Rng, "|")
For Each rngs In arr1
d(rngs) = ""
Next
i = VBA.Join(d.keys, "|")
n = n + 1
Sheet2.Cells(n, "a") = i
d.RemoveAll’清除本次循环的键值对
Next
End Sub
实例6：分类计算
字典可以通过键对应空值d(key)=d(key)+1，形成迭代计算从而统计出重复键出现次数。
而d(key)=d(key)+value，形成替换累加效果。
Sub 分类计数()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For Each Rng In arr
i = d(Rng)
d(Rng) = d(Rng) + 1
i = d(Rng)
Next
[e1].Resize(d.Count) = Application.Transpose(d.keys)
[f1].Resize(d.Count) = Application.Transpose(d.items)
End Sub
Sub 分类求和()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:c" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
[e8].Resize(d.Count) = Application.Transpose(d.keys)
[f8].Resize(d.Count) = Application.Transpose(d.items)
End Sub
实例7：多列合并计算
此例在逻辑上挺绕的，由于定义的动态数组arr(1 to 4, 1 to n),二维数组的第一维的下限不能为不确定值的变量，所以通过多层转置达到取值的目的。
Dim arr1()
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
n = n + 1
d(arr(i, 1)) = n
ReDim Preserve arr1(1 To 4, 1 To n)
arr1(1, n) = arr(i, 1)
arr1(2, n) = arr(i, 2)
arr1(3, n) = arr(i, 3)
arr1(4, n) = arr(i, 4)
Else
m = d(arr(i, 1))
arr1(2, m) = arr1(2, m) + arr(i, 2)
arr1(3, m) = arr1(3, m) + arr(i, 3)
arr1(4, m) = arr1(4, m) + arr(i, 4)
End If
Next
[f2].Resize(n, 4) = Application.Transpose(arr1)
End Sub
实例8：条目数组用法
字典的键——值方式非常的灵活，值甚至可以是数组。
Sub test() '条目数组用法
Set d = CreateObject("scripting.dictionary")
With Sheets("data")
arr = .Range("a2:e" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
For i = 1 To UBound(arr)
d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
j = d(arr(i, 1))
Next
For Each Rng In Range("a3:a" & Cells(Rows.Count, 1).End(xlUp).Row)
Rng.Offset(0, 1).Resize(1, 4) = d(Rng.Value)
Next
End Sub
总结:
字典在VBA中是种非常实用的技术，在实际运用中，与事件，控件等功能结合运用会产生一些非常实用神奇的操作。
作者：猛犸象和剑齿虎
链接：https://www.jianshu.com/p/feab2f6c6840
来源：简书
著作权归作者所有。商业转载请联系作者获得授权，非商业转载请注明出处。
浙公网安备 33010602011771号