Excel VBA字典的使用世界

[peng]

带您走进Excel VBA字典的使用世界，分享给想学习这方面的朋友

把自己近一段时间学习字典的心得写出来,高手就飘过,菜鸟级,入门的朋友和我一起来.当然有说的不对的地方,请大家指正.谢谢,申明我不是高手,因为我看过一些朋友写的字典,我也看不懂,真是羡慕他们.下面是我对字典学习一些心得分享给想了解学习这方面的朋友.

一、字典的作用
1.由于字典的关键词具有唯一性,所以字典有去重的作用,应用到按列拆分成工作表,按列拆分成工作簿,后面我们在应用的案列中讲解
2.由于字典里一个关键字对应着一个条目,我们经常用条目来编号,结合数组,应用案例有分类汇总,后面我们也用一个案例来讲解
3.速度快,在代码中用来提速

二、引用字典的方法(字典不是Excel程序里对象,是外部对象)

1.前期绑定：方法 Alt+F11 打开VBE编辑窗口-->工具菜单-->引用-->浏览-->找到scrrun.dll-->选择它-->打开-->确定
Sub 前期绑定()
Dim dic As New Dictionary
End Sub

2.后期绑定
sub 后期绑定()
Dim dic
Set dic= CreateObject("Scripting.Dictionary")
End Sub
两者的区别,前期绑定优点会弹出列表,当您输入dic.之后,后面会弹出成员列,6个方法和4个属性,方便入门的朋友学习,缺点就是把带有字典代码的工作簿发给朋友,朋友不能直接用,也要像前面讲的一样----Alt+F11 打开VBE编辑窗口-->工具菜单-->引用-->浏览-->找到scrrun.dll-->选择它-->打开-->确定,这样就给不会VBA用户带来极不方便.恰恰 相反的,后期绑定的优点就是前期绑定的缺点,后期绑定的缺点就是前期绑定的优点为,因此建议大家两都结合起来,如果你是新手的朋友,前期绑定把代码写好之后,最后再用后期绑定发给朋友.

三、字典的6个方法4个属性
dic.Add '添加关键词，方法
dic.CompareMode = 1'不区分大小写,如果等于0区分大小写
dic.Count '数字典里的关键词有多少个
dic.Exists '判断关键词在字典里是否存在
dic.Item '是指条目
dic.Key '是指关键词
dic.Items '可以返回所有条目的集合，也可以说返回一个从0开始编号的一维数组,是方法，大家不要理解为属性，不能当作对象
dic.Keys '可以返回所有的关键字词集合，也可以说返回一个从0开始编号的一维数组，也是方法
dic.Remove '清除某一个关键词
dic.RemoveAll '清除全部关键词，而数组只能清除数组的值，但不是不能清数组空间结构
而字典里的这个Removeall可以清除的结构和值，6个方法4个属性具体我们用实例来学习它。

6个方法和4个属性

1.方法add 是添加的意思
Sub test1() '给字典添加关键词和条目
'格式 字典对象+空格 +点号+add+空格+关键词+逗号+条目

Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
With dic
.Add "不及格", 0
.Add "及格", 60
.Add "良好", 70
.Add "优秀", 80
End With
End Sub

备注:'把上面的代码复制到模块里,大家一定要学会在本地窗口查看,这个是学习VBA的秘密,相当于学习数组函数要会按F9一样查看运算的结果,记住,千万要记住,一般人我不告诉的,呵呵,开了一下玩笑,把光标点到代码任何一行,视图
'菜单,本地窗口,F8逐步运行,大家可以看到关键词在不断增加,这里我没有用循环语句,当然在我们真正把数据装入关键词和条目会用到循环语句 ,有的朋友可能会说,我还没有理解这种装法,其实大家可以把字典看作多行二列的二维数组一样,一列是关键词,一列是条目,有时我们条目不装,为空,可以写成下面这样的

Sub Test2()'条目为空
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
With dic
.Add "不及格", ""
.Add "及格", ""
.Add "良好", ""
.Add "优秀", ""
End With
End Sub

现在我们来提一个问:如果要装入字典关键词重复会出现一个什么现象呢? 如

Sub Test2()'关键词重复会报错
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
With dic
.Add "不及格", ""
.Add "不及格", ""
End With
End Sub

我们运行上面的代码发现,重复装入关键字会报错,那怎么办呢,难道放在一边,让它凉拌,当然不是呢,在写程序时,有的错误是避免不了的,那我们就要想起这一句On Error Resume Next

Sub Test3() '解决了关键词重复会报错
Dim dic
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
With dic
.Add "不及格", ""
.Add "不及格", ""
End With
On Error GoTo 0 '如果后面的代码有错,让它继续报错
End Sub

这里啰嗦一个On Error Resume Next这一句,好用少用,为什么呢,如果你不在用完它后添加一句On Error GoTo 0,后面有错误它也把错误忽略掉了,这样就不便于大家找错,也就是错了也不会提醒你,所以新手要注意这个,除了用这种方法装入字典关键词和条目还有一种方法
格式 字典对象(关键字)=条目

Sub test4() '另一种方法添加关键词和条目
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic("不及格") = 0
dic("及格") = 60
End Sub

第二种方法添加我是这样理解的,也许我理解错了,dic("不及格") = 0,完整的语句应该是修改条目,由于修改条目的关键词不存在,会自动添加关键词,如果存在就会覆盖原来的,这样就会报错了,只是覆盖,完整的语句如下
dic.Item("不及格") = 0,省略了一个点号和一个item
有的朋友可能会问?
这两种有什么区别呢?
答案是肯定的,肯定有区别,区别大着呢,第一种方法是取得一个出现的,再出现重复的装不进去的,第二种方法是取得最后一次的出现的,前面出现会被覆盖.包括条目
因此利用它们的区别,我们可以应用到查找最后一次进货的和第一次出货的日期,当然前提条件我们的日期是排序的

2.Count属性:前面我们讲过,它可以统计关键词的个数

Sub test5() '
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic("不及格") = 0
dic("及格") = 60
MsgBox dic.Count
End Sub

大家运行代码,结果显示2,也就是说字典dic里的关键是2个,不是3个,上面我们讲过,因此字典有去重作用

3.Keys方法

4.Item方法
Keys的作用是把关键词从字典里读出来,一般我们把它赋一个数组,这个数组是一维的,且它的第一个编号是0,也就是它的上标是从0开始的
Items的作用是把条目从字典里读出来,一般我们把它赋一个数组,这个数组是一维的,且它的第一个编号是0,也就是它的上标是从0开始的
具体我们看一个实例

Sub test6() '验证Keys和Items方法
Dim dic, arr1, arr2
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic("不及格") = 0
dic("及格") = 60
arr1 = dic.Keys '把字典里的所有关键词赋值给数组arr1
arr2 = dic.Items '把字典里的所有条目赋值给数组arr2
With Sheets("keys和Items")
.[A1].Resize(dic.Count, 1) = Application.Transpose(arr1)
.[B1].Resize(dic.Count, 1) = Application.Transpose(arr2)
'上面的代码为什么要转,因为通过keys和Items方法读到数组都是一维的
'如果读到单元格是横向的就不用转置,因为是纵向的,所以调用工作表内置数
'Transpose函数转置一下
End With
End Sub

接下来我们讲解2个自定义函数
一个是统计区域唯一值的个数
一个是去重函数

Function 计数(Rg As Range)
Dim dic, arr1, ar
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
arr1 = Rg '把单元格区域装入到数组arr1里,因为装到数组里速度快一些
For Each ar In arr1
If ar <> "" Then ' 排除空单元格
dic(ar) = "" ' 把数组arr1里的每一个元素依次装进字典dic里,进行去重
End If
Next ar
计数 = dic.Count'把结果赋值给函数名'
End Function

Function 去重(Rg As Range, x As Integer)
Dim dic, arr1, ar
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
arr1 = Rg '把单元格区域装入到数组arr1里,因为装到数组里速度快一些
For Each ar In arr1
If ar <> "" Then ' 排除空单元格
dic(ar) = "" ' 把数组arr1里的每一个元素依次装进字典dic里,进行去重
End If
Next ar
arr1 = dic.Keys
If x <= dic.Count Then '如果函数的第二参数小于等于字典里的关键词个数,那么
去重 = arr1(x - 1) '把数组arr1(x)这个元素赋值给函数去重
Else '否则函数去重的值为空
去重 = ""
End If
End Function

' 备注,自定义去重这个函数,第一参数是单元格区域,且要加绝对引用,可以是多行多列,
'好过我们函数写的那个长长的去重公式,第二参数,如果大家是下拉就要用Row(A1),
'如=去重($A$1:$B$4,ROW(A1))
'如果右拉就用借助Column (A1)

5.方法Exists,判断关键词在字典里是否存在

Sub test7() 'Exists方法
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic("不及格") = 0
dic("及格") = 60
If dic.Exists("不及格") Then '判断"不及格"关键词是否存在
MsgBox "不及格--关键词存在"
Else
MsgBox "不及格--关键词不存在"
End If
If dic.Exists("优秀") Then '判断"不及格"关键词是否存在
MsgBox "优秀--关键词存在"
Else
MsgBox "优秀--关键词不存在"
End If
End Sub

6、Remove,清除字典里某一个关键词,且还清除其结构,而数组里的Erase,只能清除其值,不能清除数组空间结构
格式 dic.Remove "某一个关键词"
7'RemoveAll清除字典里所有关键词,且还清除其结构
格式 dic.RemoveAll

Sub test8() '方法Remove和RemoveAll
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic("不及格") = 0
dic("及格") = 60
dic("良好") = 70
dic("优秀") = 80
MsgBox dic.Count '显示字典里有4个关键词
dic.Remove "不及格"
MsgBox dic.Count '显示字典里有3个关键词,因为关键词"不及格"被删除了
dic.RemoveAll '显示字典里有0个关键词,因为关键词全部被删除了
MsgBox dic.Count
End Sub

8、Key 属性,修改字典里的关键词

9、Item属性,修改字典里的某关键词的条目
Sub test9() '属性Key和Item
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic("不及格") = 0
dic.Key("不及格") = "D" '把关键词"不及格"修改为"D"
dic.Item("D") = 59 '把关键词"D"的条目修改为59
End Sub

备注:至于在本地窗口的变化,自己去查看,我不再多说了

10.'CompareMode '属性 比较模式 如 Dic.CompareMode=1不区分大小写，Dic.CompareMode=0区分大小写

Sub test10() '区分大小写,默认不写是区分的,因此我们只有在不区分时才补上这句
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic.Add "D", 0
dic.Add "d", 0
'因为默认的是区域大小写的,所以不报错
End Sub
Sub test11() '不区分大小写,
Dim dic
Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
dic.CompareMode = 1
dic.Add "D", 0
dic.Add "d", 0
'上面的代码报错了,因为dic.CompareMode = 1不区分大小写,所以
'你装后大写的D之后,再装小写的d,重装了,报错
End Sub

6个方法和4个属性我们就讲完了,谢谢大家，后面我们用大家在工作常用的实例来讲解
第一个案例:
1.多行2列分类汇总
2.多行多列分类汇总
第二个代码我就不加注解了,同第一个代码差不多,区别是
由于关键字只能装1列,如果有多列怎么办呢?
我们可以把多列用&串起来,多串字符串就变成了一串字符串
第二个案例用字典做查询表
第三个案例
透视表式的字典
Option Explicit
按列拆分成工作表
按列拆分成独立的工作簿
小伙伴，大家一起学习Excel VBA知识，一起进步。同时欢迎大家帮忙转发并关注，谢谢大家的支持！

[peng]

在VBA中字典的应用方法

大家好，我们今日继续讲解VBA数组与字典解决方案第37讲内容：在VBA中字典的应用。对于字典,也许许多的朋友对此比较陌生，在有的语言里字典也称之为MAP,应用也是比较广泛的。
字典，其实就是一些"键－值"对。使用起来非常方便，有类似于微型数据库的作用，可用于临时保存一些数据信息。

一VBA中创建字典：用的是WSH引用。
Dim myd As Object
Set myd = CreateObject("Scripting.Dictionary")

二字典的方法，有Add、Exists、Keys、Items、Remove、RemoveAll，六个方法。
①Add 用于添加内容到字典中。如myd.Add key, item 第一个参数为键，第二个参数为键对应的值
②Exists用于判断指定的关键词是否存在于字典（的键）中。如myd.Exists(key)。如果存在，返回True，否则返回False。通常会在向字典中添加条目的时候使用，即先判断字典中是否已存在这个记录，如果不存在则新增，否则进行其它的操作。
③Keys获取字典所有的键，返回类型是数组。如myd.Keys()
④Items获取字典所有的值，返回类型是数组。如myd.Items()
⑤Remove从字典中移除一个条目，是通过键来指定的。myd.Remove(key)如果指定的键不存在，会发生错误。
⑥RemoveAll 清空字典。

三字典的属性有Count、Key、Item、ConpareMode四种属性
①Count用于统计字典中键－值对的数量。也可以简单理解为统计字典中键的个数；
②Key用于更改字典中已有的键。如：myd.Key("oapp") = "Orange" 如果指定的键不存在，则会产生错误。
③Item用于写入或读取字典中指定键的值，如果指定的键不存在，则会新增。如.Item("oapp") = 10
下面以一个实例来说明字典的应用：在下图的A列有不同的键，要在对应的键中写入键值，然后把C列对应的键去掉，并任意增加一个键，最后在E,F列写出最后的键和键值,代码如下：

Sub MyNZsz_37() '第37讲 字典的应用
Dim dic As Object
Sheets("37").Select
Set dic = CreateObject("Scripting.Dictionary") '引用字典
Dim arr(1 To 21), i As Long '建立一个数组用来给键赋值
For i = 1 To 21
arr(i) = i + 99
Next i
For i = 1 To 20
dic(Cells(i, "a").Value) = arr(i) '写入键和键值，要注意写入的方法
Next i
i = 1
Do While Cells(i, 3) <> ""
dic.Remove (Cells(i, "c").Value) '移除C列的键值
i = i + 1
Loop
dic.Add "WW21", "234" '增加一个键，键值是234
[e1].Resize(dic.Count, 1) = Application.Transpose(dic.Keys) '转置显示键
[f1].Resize(dic.Count, 1) = Application.Transpose(dic.items) '转置显示键值
End Sub

代码讲解:
1. 上述代码首先创建一个字典对象,然后,把工作表A列的值放到数组，作为键；第三步是给字典的键赋值，第四步移除C列的键对，第五步，增加一个键，第六步显示
2 Set dic = CreateObject("Scripting.Dictionary") '引用字典
字典的加载有两种办法，一个是CreateObject("Scripting.Dictionary")，另外一个是引用，就是在VBE窗口，打开引用，找到Dictionary的引用即可，本书中大多以SET形式来引用字典
3 For i = 1 To 21
arr(i) = i + 99
Next i
赋值一维数组，作为键值
4 For i = 1 To 20
dic(Cells(i, "a").Value) = arr(i) '写入键和键值，要注意写入的方法
Next i
写入键和键值。要特别注意是我实例中的写法
5 dic.Remove (Cells(i, "c").Value) '移除C列的键值
上述代码移除键和键值.
6 dic.Add "WW21", "234" '增加一个键，键值是234
上述代码增加键和键值.
6 [e1].Resize(dic.Count, 1) = Application.Transpose(dic.Keys) '转置显示键
[f1].Resize(dic.Count, 1) = Application.Transpose(dic.items) '转置显示键值
显示键和键值