这段时间感觉就像邯郸学步，但是因为投入了很多时间和精力在python上，之前学的vba直到想用的时候都忘了。
作为非程序员，编程总是被用作“核导弹”。 做一次，可以使用。 是的，我已经很难有机会写第二次代码了。 因为问题解决了，所以一直处于忘记的状态。 又想用的时候摸资料和笔记。
VBA词典技术
VBA词典是日常统计工作中非常有用的技术，但在编写程序时，由于不熟练、个人记忆力有限，必须重读资料，产生了将常用词典技术放在一起的想法。
一.入门篇
字典：是为单词提供音韵、语义解释、例句、用法等的工具书。
在VBA中，词典与传统理解的词典几乎相同：
1、关键词(key )和值(item )存在一一对应关系，
2、键具有唯一性。
VBA词典的作用有与数组联合运用、代码简化(实际上是以内存为代价，使用空间来换取时间的方法，但在当今时代通用的电脑中，普遍的内存就足够了)、速度的提高等几个强大的功能。
如果词典不存在和VBA，则需要调用。 有两种方法。
1、在前期绑定、excel表格开发工具中，找到工具-浏览-浏览scrrun.dll-确定；
2、后绑定，直接用代码编写调用： setd=createobject (scripting.dictionary ) ) ) ) ) )。
本文主要采用后绑定方式记录词典的使用方法。
词典对象有六种方法：
Add添加关键字和条目
Keys返回所有关键字(形成一维数组)。
Items将返回所有条目。 形成一维数组
有Exists关键字吗？ 真/假
Remove删除关键字和相应的条目
RemoveAll删除所有关键字和对应条目
将关键字项对添加到Dictionary对象中。
语法： object.add(key，item ) )。
Key，必需的选项。 与添加的item相关联的密钥。
Item，必需的选项。 与添加的key关联的item。
key是唯一存在的。 否则会出错。
实例1:Sub kaishi (
'词典的密钥索引从零开始是第一个密钥
Dim d As New Dictionary，I，j，k，l
setd=createobject (scripting.dictionary ) )。
d.Add 'czdfj '，' 15 '
d.Add 'dbdsy '，' 18 '
基础取值方法
I=d.keys(0) )。
j=application.worksheet function.index (d.keys，2 ) )。
k=d.keys’keys返回数组，因此可以用Index方法取值
L=K(1) )。
' Exists方法
'如果Dictionary对象中存在指定的关键字，则返回true；如果该关键字不存在，则返回false。
' a=d.exists (数据库dsy ) ) )。
'移除方法
' Remove方法从Dictionary对象中清除键——值对。
d .移除(数据库dsy ) ) ) )。
'移除所有方法
' RemoveAll方法从单个Dictionary对象中清除所有键——值对。
d .移除全部
最终辅
词典对象的属性有四个。
比较模式属性
计数属性
Key属性
Item属性
例2 :子测试() ) ) ) ) )。
setd=createobject (scripting.dictionary ) )。
'1.比较模式属性
'设置或返回在Dictionary对象上比较字符串关键字时使用的比较模式。
d.CompareMode=0 '1不区分大小写，0区分大小写，默认值为1
d.Add 'a '，''
d.Add 'A '，''
d.Add 'czdfj '，' 13434544323 '
d.Add 'dbdsy '，' 13589898999 '
d.Add '纯情冥王星'，' 13456565567 '
'2.Count属性
' Dictionary对象中的项目数.返回只读属性
k=d.Count
'3.Key属性
'在Dictionary对象中修改密钥。
d.Key ('纯情冥王星)='三斤牛)。
'4.Item属性
'在Dictionary对象中，设置或返回指定密钥的item。 关于集合要看地点
指定的 key 返回一个 item。i = d.Items
d.Item("czdfj") = "112233"
i = d.Items
d("czdfj") = 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中是种非常实用的技术，在实际运用中，与事件，控件等功能结合运用会产生一些非常实用神奇的操作。