1、字典基本（赵侦宇搜集整理）
(1)、创建字典
Sub 字典()
Set d = CreateObject("scripting.dictionary")
End Sub
注意一点，如果用画矩形、椭圆的方式，要制定在那个表格（sheet1、sheet2或sheet3）中操作(2)、赋值
分别用两种范式赋值
Sub 字典()
Set d = CreateObject("scripting.dictionary")
For x = 1 To 4
d.Add Cells(x, "a").Value, Cells(x, "b")
Next
End Sub
①、蓝区域相当于字典的条目，这个区域内容不可以重复。红区域是条目对应的解释
②、直接赋值（赋值的时候value一定要带上）
③、赋值数组条目部分不能用数字，不知道为什么
Sub 矩形1_单击()
Worksheets("sheet1").Activate
Set d = CreateObject("scripting.dictionary")
For x = 1 To 4
d(Cells(x, "a").Value) = Cells(x, "b")
Next
MsgBox d("女孩")
End Sub
(3)、修改字典
Sub 矩形1_单击()
Worksheets("sheet1").Activate
Set d = CreateObject("scripting.dictionary")
For x = 1 To 4
d(Cells(x, "a").Value) = Cells(x, "b")
Next
d("男孩") = "陈佩斯"
MsgBox d("男孩")
End Sub
(4)、输出字典内容
Sub 矩形1_单击()
Worksheets("sheet1").Activate
Set d = CreateObject("scripting.dictionary")
For x = 1 To 4
d(Cells(x, "a").Value) = Cells(x, "b")
Next
d("男孩") = "陈佩斯"
Range("d1").Resize(d.Count, 1) = Application.Transpose(d.keys)
Range("e1").Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing
End Sub
①、resize重组一个区域，resize(X,Y)，X是区域的行数，Y是区域的列数
②、d.count是resize中区域的行数，表示字典中条目的数量，本例为4
③、transpose是转置的意思，d.keys可以将字典第一列提取出来，但提取的结果是横向的，即“猫，狗，男孩，女孩”，所以要转置，转为列。
④、d.keys和d.items见图
d.keys为A列、d.items为B列
输出的结果为
字典实际操作例子
实例1：入库汇总问题
提问者想达到的目的是：根据B列的产品件号，汇总D列—入库数量，L列—单价，N列—发票金额。然后，将汇总的内容按照产品件号，填入工作表2的对应区域。
Sub 字典汇总()
'建立字典
Set d = CreateObject("scripting.dictionary")
Dim a As Integer, b As Integer, sin1 As Integer
sin1 = Sheet1.Range("b65536").End(xlUp).Row
'字典读入数据
For a = 1 To sin1 - 2
stmp = Sheet1.Cells(a + 2, "b")
d(stmp) = ""
Next
'将字典的keys赋值给数组
Dim arrkey
arrkey = Application.WorksheetFunction.Transpose(d.keys)
'建立数组arrRT，汇总需要的数据
Dim arrRT
ReDim arrRT(1 To d.Count, 1 To 4)
For a = 1 To d.Count
For b = 1 To sin1 - 2
arrRT(a, 1) = arrkey(a, 1)
If Sheet1.Cells(b + 2, "b") = arrRT(a, 1) Then
arrRT(a, 2) = arrRT(a, 2) + Sheet1.Cells(b + 2, "e")
End If
If Sheet1.Cells(b + 2, "b") = arrRT(a, 1) Then
arrRT(a, 3) = arrRT(a, 3) + Sheet1.Cells(b + 2, "l")
End If
If Sheet1.Cells(b + 2, "b") = arrRT(a, 1) Then
arrRT(a, 4) = arrRT(a, 4) + Sheet1.Cells(b + 2, "n")
End If
Next
Next
Dim sin2 As Integer
sin2 = Sheet2.Range("a65536").End(xlUp).Row
'将汇总内容填入对应表格的位置
For a = 1 To d.Count
For b = 1 To sin2
If arrRT(a, 1) = Sheet2.Cells(b + 2, "a") Then
Sheet2.Cells(b + 2, "d") = arrRT(a, 2)
Sheet2.Cells(b + 2, "e") = arrRT(a, 3)
Sheet2.Cells(b + 2, "f") = arrRT(a, 4)
End If
Next
Nextresize函数vba
Set d = Nothing
End Sub
知识点：
①、字典对数据的格式有要求，比如同样的字符串，“1385202”，手工输入和从别处复制过来，可能字典会认为是不同的key
②、将字典的keys复制给数组，两种形式
A、arrkey=d.keys，这种方式产生的数组上下限为别为(0，d.count-1)，数组是单行，加上option base 1没用
Option base 1目前只对array函数数组有用，对字典keys数组和split函数均不管用。
B、arrkey = Application.WorksheetFunction.Transpose (d.keys)，这种方式产生的数组上下限分别为(1，d.count)，数组是单列
实例2：前两位数字相加
Sub 分条件()
Dim sin1 As Integer, sin2 As Integer
sin1 = Sheet1.Range("a65536").End(xlUp).Row
sin2 = Sheet1.Range("b65536").End(xlUp).Row
Dim a As Integer, b As Integer
'建立数组，提取出第一位数字和第二位数字，相加
Dim arrdata
ReDim arrdata(1 To sin1, 1 To 5)
For a = 1 To sin1
arrdata(a, 1) = Sheet1.Cells(a, "a")
arrdata(a, 2) = Left(arrdata(a, 1), 2)
arrdata(a, 3) = Left(arrdata(a, 2), 1)
arrdata(a, 4) = Right(arrdata(a, 2), 1)
arrdata(a, 5) = CSng(arrdata(a, 3)) + CSng(arrdata(a, 4))
Next
'根据要求的条件对比，将不符合条件的去除
For a = 1 To sin1
For b = 2 To sin2
If CSng(arrdata(a, 5)) = CSng(Sheet1.Cells(b, "b")) Then
arrdata(a, 1) = ""