小白看“蓝桥玄霜”老师的实例学字典

renahu

首先感谢“蓝桥玄霜”老师的讲解，真的非常详细，非常适合初学者：常见字典用法集锦及代码详解
http://club.excelhome.net/thread-868892-1-1.html

实例一：
Sub cfz()
Dim i&, Myr&, Arr
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:g" & Myr)
For i = 2 To UBound(Arr)
    d(Arr(i, 3)) = d(Arr(i, 3)) + 1                  ' 已解决：看来d(key)不光等于关键字key对应的项，d（key）还能够往字典中加入没有的key
Next
k = d.keys
t = d.items
Sheet2.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)
[a1].Resize(1, 2) = Array("姓名", "重复个数")
Set d = Nothing
End Sub

三、代码详解
1、Dim i&, Myr&, Arr ：变量i和Myr声明为长整型变量。 也可以写为 Dim Myr As Long 。Long 的类型声明字符为(&)。Arr后面没有写明数据类型，默认就是可变型数据类型(Variant)。
2、Set d = CreateObject("Scripting.Dictionary")：创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用c:\windows\system32\scrrun.dll了。
3、Myr = Sheet1.[a65536].End(xlUp).Row ：把表1的A列最后一行不为空白的行数赋给变量Myr。这里用了Range对象的End属性，它有4个方向参数，此处的xlUp表示向上，它的值为3，所以也可写成End(3)。xlDown表示向下，它的值为4；xlToLeft表示向左，它的值为1；xlToRight表示向右，它的值为2。
4、Arr = Sheet1.Range("a1:g" & Myr)：把表1的A1到G列最后一行不为空白的 单元格区域的值赋给变量Arr。这样Arr就是个二维数组了，用数组替代单元格引用可对执行代码的速度提高很多很多。
5、For i = 2 To UBound(Arr) ：For…Next循环结构，从2开始到数组的最大上界值之间循环。因为数组的第一行是表头。Ubound是VBA函数，返回数组的指定维数的最大可用上界。
6、d(Arr(i, 3)) = d(Arr(i, 3)) + 1 ：Arr(i,3)在本例是姓名列，也就是关键字列，举个例子，假如Arr(i,3)=”张三”，这句代码的意思就是把关键字”张三”加入字典，d(key)等于关键字key对应的项，每出现一次这个关键字，它的项的值就增加1。起到了按关键字累加的作用，也正因为有这个作用，所以可使用字典来进行各种汇总统计。后面要讲的实例会充分的展现这个作用。
7、k=d.keys ：把字典d中存在的所有的关键字赋给变量k。得到的是一个一维数组，下限为0，上限为d.Count-1。Keys是字典的方法，前面已经讲过了。
8、t=d.items ：把字典d中存在的所有的关键字对应的项赋给变量t。得到的也是一个一维数组，下限为0，上限为d.Count-1。Items也是字典的方法，前面也已经讲过了。
9、Sheet2.Activate ：激活表2。
10、[a2].Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的关键字赋给以a2单元格开始的单元格区域中。详细的解释请见前面的keys方法一节。
11、[b2].Resize(d.Count, 1) = Application.Transpose(t) ：把字典d中所有的关键字对应的项赋给以b2单元格开始的单元格区域中。
12、[a1].Resize(1, 2) = Array("姓名", "重复个数") ：Array是一个VBA函数，返回一个下界为0的一维数组。一维数组是水平排列的，所以赋值给水平的单元格区域不需要用转置函数了。这里作为表头一次性输入。
13、Set d = Nothing  ：释放字典内存。

问题：
没有理解第六条：
6、d(Arr(i, 3)) = d(Arr(i, 3)) + 1 ：Arr(i,3)在本例是姓名列，也就是关键字列，举个例子，假如Arr(i,3)=”张三”，这句代码的意思就是把关键字”张三”加入字典，d(key)等于关键字key对应的项，每出现一次这个关键字，它的项的值就增加1。起到了按关键字累加的作用，也正因为有这个作用，所以可使用字典来进行各种汇总统计。后面要讲的实例会充分的展现这个作用。

这里看懂了建立了一个字典d，和一个二维数组Arr，那如何把数组中的内容加入到字典中呢？怎么没用到 object.Add (key, item) 这个方法呢？ 难道是通过d(Arr(i, 3)) 把字典内容加进去的？ d(key)是什么意思? 好像在前面的方法和属性介绍中没提到。请蓝桥玄霜 老师或明白的朋友给解释一下，谢谢。

unsamesky

d.Add arr(i,3), n
这个是字典的ADD函数的正式用法，就是你所说的 object.Add (key, item)，上面的arr(i,3)就是key, n就是Item，其中Key不允许重复，而n允许为任意值

d(Arr(i, 3)) = d(Arr(i, 3)) + 1
这种字典的用法，是字典的一种属性，字典对象如果直接使用 d(key)这样的方式引用的时候，如果字典中的key值不存在，那么字典将自动添加这个不存在的key进入d.keys。如果key存在，那么则直接调用指定的key。

renahu

看来“蓝桥玄霜”老师应该在前面的基础知识中加上 d（key）的一些知识，特别是它能够往字典中加入没有的key。好了，继续学习下个例子。

renahu

unsamesky 发表于 2014-8-16 12:35
d.Add arr(i,3), n
这个是字典的ADD函数的正式用法，就是你所说的 object.Add (key, item)，上面的arr(i,3 ...

非常感谢，看来往字典中增加key，不光是用方法 d.Add ，还有自动加进去的，开始明白些了，那如果用最直接的方法，即：d.Add arr(i,3), n 能不能把这段代码改写一下，虽然没这个简洁，但也想看看怎么用，谢谢

unsamesky

renahu 发表于 2014-8-16 13:07
非常感谢，看来往字典中增加key，不光是用方法 d.Add ，还有自动加进去的，开始明白些了，那如果用最直接 ...

1. Sub cfz()
   
2. Dim i&, Myr&, Arr
   
3. Dim d, k, t
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Myr = Sheet1.[a65536].End(xlUp).Row
   
6. Arr = Sheet1.Range("a1:g" & Myr)
   
7. For i = 2 To UBound(Arr)
   
8.     If Not d.Exists(arr(i,3)) Then   '先利用字典的Exists存在函数判断arr(i,3)这个key是否存在
   
9.         d.Add arr(i,3),1
   
10.     Else
    
11.         d(Arr(i, 3)) = d(Arr(i, 3)) + 1
    
12.     End if
    
13. Next
    
14. k = d.keys
    
15. t = d.items
    
16. Sheet2.Activate
    
17. [a2].Resize(d.Count, 1) = Application.Transpose(k)
    
18. [b2].Resize(d.Count, 1) = Application.Transpose(t)
    
19. [a1].Resize(1, 2) = Array("姓名", "重复个数")
    
20. Set d = Nothing
    
21. End Sub

复制代码

jiminyanyan

字典帖很多的，看不懂，换个帖看一下。。。。。。。

renahu

实例3  A列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出：
有1、2、3…1000一千个数字，要求编写一段代码，在工作表的A列显示这些数被6除余1和余5的数字。
Sub 余1余5()  ‘by:狼版主
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), ""
Next
arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))
[a1].Resize(UBound(arr), 1) = arr                          这里有个疑问：UBound(arr) 是否应该加1 ？即：[a1].Resize(UBound(arr)+1, 1) = arr，不过我试了一下，加1后显示错误：#N/A        已解决：一位数组转置后变二维数组，arr先转置了，所以不加1   
[a:a].Replace "@", ""
Set dic = Nothing
End Sub
代码详解
1、Dim dic As Object, i As Long, arr  ：也可把字典变量dic声明为对象(Object)，i As Long是规范的写法，也可写成i& 。
2、dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), "" ：这句代码的内容比较多，用了两个VBA函数IIf和Abs，用了一个Mod运算符。i Mod 6就是每一个数除6的余数，题目中有两个要求：余1和与5，为了从1到1000都同时能满足这两个要求，所以用了Abs(i Mod 6 - 3) = 2 ，Abs是取绝对值函数。另一个VBA函数IIf是根据判断条件返回结果，和If…Then判断结果类似；IIf(Abs(i Mod 6 - 3) = 2, "@", "") 这段的意思是如果符合判断条件，返回”@”否则返回空””。 i & IIf(Abs(i Mod 6 - 3) = 2, "@", "")的意思是把这个数与”@”或者”””连起来作为关键字加入字典dic，关键字相对应的项为空。比如当i=1时，1是满足上述表达式的，就把”1@” 作为关键字加入字典dic；当i=2时，2不满足上述表达式，就把”2” 作为关键字加入字典dic，关键字相对应的项都为空。
3、arr = WorksheetFunction.Transpose(Filter(dic.keys, "@")) ：这句代码的内容分为3部分，第1部分是Filter(dic.keys, "@") 其中的Filter是一个VBA函数，VBA函数就是可以直接在代码中使用的，我们平常使用的函数叫工作表函数，如Sum、Sumif、Transpose等等。Filter函数要求在一维数组中筛选出符合条件的另一个一维数组，式中的dic.keys正是一个一维数组。这里的筛选条件是”@”，也就是把字典关键字中含有@的关键字筛选出来组成一个新的一维数组，其下标从零开始。第2部分是用工作表函数Transpose转置这个新的一维数组，工作表函数的使用在前面keys方法一节已经说过了；第2部分是把转置以后的值赋给数组变量Arr。
呵呵，狼版主的代码是短了，我的解释却太长了。
4、[a1].Resize(UBound(arr), 1) = arr ：把数组Arr赋给[a1]单元格开始的区域中。
5、[a:a].Replace "@", ""  ：把A列中的所有的@都替换为空白，只剩下数字了。

renahu

实例4  拆分数据不重复
一、问题的提出：
有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。
二、代码：
Sub caifen()
Dim Myr&, Arr, x&
Dim d, d1, d2, i&, j&
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Myr = [a65536].End(xlUp).Row
Arr = Range("a2:a" & Myr)
Range("c2:e" & Myr).ClearContents
my = Array("MOTO", "诺基亚", "三星", "索爱")
gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派")
For x = 1 To UBound(Arr)
    For i = 0 To UBound(my)
        If InStr(Arr(x, 1), my(i)) > 0 Then
            d(Arr(x, 1)) = ""
            GoTo 100
        End If
    Next i
    For j = 0 To UBound(gc)
        If InStr(Arr(x, 1), gc(j)) > 0 Then
            d1(Arr(x, 1)) = ""
            GoTo 100
        End If
    Next j
    d2(Arr(x, 1)) = ""
100:
Next x
Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)    ’这里加1了，正确，因为一维数组上限是0，可是例3怎么不加1？      已解决：等号左边的d.keys 是一维数组，所以加1   
Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)
Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)
End Sub      

代码详解
1、Set d2 = CreateObject("Scripting.Dictionary")  ：针对三个不同的种类，创建d、d1、d2三个字典对象。
2、Myr = [a65536].End(xlUp).Row  ：把A列最后一行不为空白的行数赋给变量Myr。
3、Arr = Range("a2:a" & Myr)  ：把A2开始的有数据的单元格区域赋给变量Arr。
4、Range("c2:e" & Myr).ClearContents ：把C2到E列单元格区域清空。
5、my = Array("MOTO", "诺基亚", "三星", "索爱") ：VBA函数Array返回一个一维数组，默认下界为0。把Array函数返回的数组赋给变量my(贸易两汉字的首字母)。
6、gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派") ：把Array函数返回的数组赋给变量gc(国产两汉字的首字母)。
7、For x = 1 To UBound(Arr) ：在A列原始数据的数组中逐一循环。
8、For i = 0 To UBound(my) ：在my数组中逐一循环。因为有4个贸易机品牌，所以用循环每一个与原始数据比较。
9、If InStr(Arr(x, 1), my(i)) > 0 Then ：VBA函数Instr返回在第1个参数中查找的位置，如果返回结果＝0，表示在第1个参数中没有第2个参数存在。本句的意思是如果找到贸易机品牌的话，执行下面的代码。
10、d1(Arr(x, 1)) = "" ：接上句，如果上面判断成立，就把Arr(x, 1)加入字典d。
11、GoTo 100 ：Goto语句用于无条件地转移到过程中指定的行。这里采用跳出For i循环，一是为了减少循环的次数，比如"MOTO"找到的话，后面3个就不需要找了；二是为了跳过两个小循环之后的其它品牌加入第3个字典的d2(Arr(x, 1)) = ""语句。
12、For j循环与上面相同，为了判断得到国产机类的字典d1。
13、d2(Arr(x, 1)) = "" ：如果上述两个小循环都不满足，那么就加入其它品牌类字典里。
14、Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys) ：最后的3句分别把字典的关键字数组转置后赋给相应的单元格区域。

jiminyanyan

renahu 发表于 2014-8-16 15:16
实例3  A列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出：
有1、2、3…1000一千个数字，要求编 ...

arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))
你可以调试一下，到这里后下标是1。。。。。。
UBound(arr) 不加1了。。。。
UBound(arr) -LBound(arr)+ 1
这样总没错。。。。

unsamesky

renahu 发表于 2014-8-16 15:27
实例4  拆分数据不重复
一、问题的提出：
有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划 ...

因为通过Tranpose转置得到的数组为二维数组，数组下标为1。
比如：arr(0 to 3)
for i = 0 to 3
    arr(i) = i
next
brr = worksheetfunction.Tranpose(arr)
那么得到的brr是一个二维数组：
brr(1,1) = arr(0)
brr(2,1) = arr(1)
brr(3,1) = arr(2)
brr(4,1) = arr(3)

所以：ubound(brr) = 4