常见字典用法集锦及代码详解

蓝桥玄霜 · 发表于 2010-10-18 13:48

前言

凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。

凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。

字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。深受大家的喜爱。

本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。

给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。

字典的简介

字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。

附带提一下，有名的正则表达式（RegExp）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject
）对象也是微软Windows脚本语言中的一份子。

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。比如字典的“典”字的解释是这样的：

“典”字就是具有唯一性的关键字，后面的解释就是它的项，和“典”字联合组成一对数据。

常用关键字英汉对照：

Dictionary 字典

Key 关键字

Item 项，或者译为
条目

字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

Add方法

向
Dictionary 对象中添加一个关键字项目对。

object.Add (key, item)

参数

object

必选项。总是一个
Dictionary 对象的名称。

key

必选项。与被添加的
item 相关联的
key。

item

必选项。与被添加的
key 相关联的
item。

说明

如果
key 已经存在，那么将导致一个错误。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

代码详解

1、Dim d ：创建变量，也称为声明变量。变量d声明为可变型数据类型(Variant)，d后面没有写数据类型，默认就是可变型数据类型(Variant)。也有写成Dim d As Object的，声明为对象。

2、Set d = CreateObject("Scripting.Dictionary")：创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用c:\windows\system32\scrrun.dll了。

3、d.Add "a", "Athens"：添加一关键字”a”和对应于它的项”Athens”。

4、d.Add "b", “Belgrade”：添加一关键字”b”和对应于它的项”Belgrade”。

5、d.Add "c", “Cairo”：添加一关键字”c”和对应于它的项”Cairo”。

Exists方法

如果
Dictionary 对象中存在所指定的关键字则返回
true，否则返回
false。

object.Exists(key)

参数

object

必选项。总是一个
Dictionary 对象的名称。

key

必选项。需要在
Dictionary 对象中搜索的
key 值。

常用语句：

Dim d, msg$

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

If d.Exists("c") Then

msg = "指定的关键字已经存在。"

Else

msg = "指定的关键字不存在。"

End If

代码详解

1、Dim d, msg$ ：声明变量，d见前例；msg$ 声明为字符串数据类型(String)，一般写法为Dim msg As String。String
的类型声明字符为美元号 ($)。

2、If d.Exists("c") Then：如果字典中存在关键字”c”，那么执行下面的语句。

3、msg = "指定的关键字已经存在。"
：把"指定的关键字已经存在。"字符串赋给变量msg。

4、Else
：否则执行下面的语句。

5、msg = "指定的关键字不存在。"
：把"指定的关键字不存在。"字符串赋给变量msg。

6、End If
：结束If …Else…Endif判断。

Keys方法

返回一个数组，其中包含了一个 Dictionary 对象中的全部现有的关键字。

object.Keys( )

其中 object 总是一个 Dictionary 对象的名称。

常用语句：

Dim d, k

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

k=d.Keys

[B1].Resize(d.Count,1)=Application.Transpose(k)

代码详解

1、Dim d, k ：声明变量，d见前例；k默认是可变型数据类型(Variant)。

2、k=d.Keys：把字典中存在的所有的关键字赋给变量k。得到的是一个一维数组，下限为0，上限为d.Count-1。这是数组的默认形式。

3、[B1].Resize(d.Count,1)=Application.Transpose(k)
：这句代码是很常用很经典的代码，所以这里要多说一些。

Resize是Range对象的一个属性，用于调整指定区域的大小，它有两个参数，第一个是行数，本例是d.Count，指的是字典中关键字的数量，整本字典中有多少个关键字，本例d.Count=3，因为有3个关键字。呵呵，是不是说多了。

第二个是列数，本例是1。这样＝左边的意思就是：把一个单元格B1调整为以B1开始的一列单元格区域，行数等于字典中关键字的数量d.Count，就是把单元格B1调整为单元格区域B1：B3了。

＝右边的k是个一维数组，是水平排列的，我们知道Excel工作表函数里面有个转置函数Transpose，用它可以把水平排列的置换成竖向排列。但是在VBA中不能直接使用该工作表函数，需要通过Application对象的WorksheetFunction属性来使用它。所以完整的写法是Application. WorksheetFunction.Transpose(k)，中间的WorksheetFunction可省略。现在可以解释这句代码了：把字典中所有的关键字赋给以B1单元格开始的单元格区域中。

Items方法

返回一个数组，其中包含了一个 Dictionary 对象中的所有项目。

object.Items( )

其中 object 总是一个 Dictionary 对象的名称。

常用语句：

Dim d, t

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

t=d.Items

[C1].Resize(d.Count,1)=Application.Transpose(t)

代码详解

1、Dim d, t ：声明变量，d见前例；t默认是可变型数据类型(Variant)。

2、t=d.Items ：把字典中所有的关键字对应的项赋给变量t。得到的也是一个一维数组，下限为0，上限为d.Count-1。这是数组的默认形式。

3、[C1].Resize(d.Count,1)=Application.Transpose(t)
：有了上面Keys方法的解释这句代码就不用多说了，就是把字典中所有的关键字对应的项赋给以C1单元格开始的单元格区域中。

"常见字典用法集锦及代码详解"（全文）：

tl7pJqij.rar (448.99 KB, 下载次数: 1583)

蓝桥玄霜 · 发表于 2010-10-18 13:48

Remove方法

Remove 方法从一个 Dictionary 对象中清除一个关键字，项目对。

object.Remove(key )

其中 object 总是一个 Dictionary 对象的名称。

key

必选项。key 与要从 Dictionary 对象中删除的关键字，项目对相关联。

说明

如果所指定的关键字，项目对不存在，那么将导致一个错误。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

……

d.Remove(“b”)

代码详解

1、d.Remove(“b”)：清除字典中”b”关键字和与它对应的项。清除之后,现在字典里只有2个关键字了。

RemoveAll方法

RemoveAll 方法从一个 Dictionary 对象中清除所有的关键字，项目对。

object.RemoveAll( )

其中 object 总是一个 Dictionary 对象的名称。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

……

d.RemoveAll

代码详解

1、d.RemoveAll：清除字典中所有的数据。也就是清空这字典，然后可以添加新的关键字和项，形成一本新字典。

字典对象的属性有4个：Count属性、Key属性、Item属性、CompareMode属性。

Count属性

返回一个Dictionary 对象中的项目数。只读属性。

object.Count

其中 object一个字典对象的名称。

常用语句：

Dim d,n%

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

n = d.Count

代码详解

1、Dim d, n% ：声明变量，d见前例；n被声明为整型数据类型(Integer)。一般写法为Dim n As Integer 。 Integer 的类型声明字符为百分比号 (%)。

2、n = d.Count ：把字典中所有的关键字的数量赋给变量n。本例得到的是3。

Key属性

在 Dictionary 对象中设置一个 key。

object.Key(key) = newkey

参数：

object

必选项。总是一个字典 (Dictionary) 对象的名称。

key

必选项。被改变的 key 值。

newkey

必选项。替换所指定的 key 的新值。

说明

如果在改变一个 key 时没有发现该 key，那么将创建一个新的 key 并且其相关联的 item 被设置为空。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

d.Key("c") = "d"

代码详解

1、d.Key("c") = "d" ：用新的关键字”d”来替换指定的关键字”c”，这时，字典中就没有关键字c了，只有关键字d了，与d对应的项是”Cairo”。

Item属性

在一个 Dictionary 对象中设置或者返回所指定 key 的 item。对于集合则根据所指定的 key 返回一个 item。读/写。

object.Item(key)[ = newitem]

参数

object

必选项。总是一个Dictionary 对象的名称。

key

必选项。与要被查找或添加的 item 相关联的 key。

newitem

可选项。仅适用于 Dictionary 对象；newitem 就是与所指定的 key 相关联的新值。

说明

如果在改变一个 key 的时候没有找到该 item，那么将利用所指定的 newitem 创建一个新的 key。如果在试图返回一个已有项目的时候没有找到 key，那么将创建一个新的 key 且其相关的项目被设置为空。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

MsgBox d.Item("c")

代码详解

1、d.Item("c") ：获取指定的关键字”c”对应的项。

2、MsgBox ：是一个VBA函数，用消息框显示。如果要详细了解MsgBox函数的，可参见我的另一篇文章“常用VBA函数精选合集”。http://club.excelhome.net/thread-387253-1-1.html

CompareMode属性

设置或者返回在 Dictionary 对象中进行字符串关键字比较时所使用的比较模式。

object.CompareMode[ = compare]

参数

object

必选项。总是一个 Dictionary 对象的名称。

compare

可选项。如果提供了此项，compare 就是一个代表比较模式的值。可以使用的值是 0 (二进制)、1 (文本), 2 (数据库)。

说明

如果试图改变一个已经包含有数据的 Dictionary 对象的比较模式，那么将导致一个错误。

常用语句：

Dim d

Set d = CreateObject("Scripting.Dictionary")

d.CompareMode = vbTextCompare

d.Add "a", "Athens"

d.Add "b", "Belgrade"

d.Add "c", "Cairo"

d.Add " B ", " Baltimore"

代码详解

1、d.CompareMode = vbTextCompare ：设置字典的比较模式是文本，在这种比较模式下不区分关键字的大小写，即关键字”b”和”B”是一样的。vbTextCompare的值为1，所以上式也可写为 d.CompareMode =1 。如果设置为vbBinaryCompare（值为0），则执行二进制比较，即区分关键字的大小写，此种情况下关键字”b”和”B”被认为是不一样的。

2、d.Add " B ", " Baltimore" ：添加一关键字”B”和对应于它的项”Baltimore”。由于前面已经设置了比较模式为文本模式，不区分关键字的大小写，即关键字”b”和”B”是一样的，此时发生错误添加失败，因为字典中已经存在”b”了，字典中的关键字是唯一的，不能添加重复的关键字。

蓝桥玄霜 · 发表于 2010-10-18 13:49

实例1 普通常见的求不重复值问题

一、问题的提出：

表格中人员有很多是重复的，要求编写一段代码，把重复的人员姓名以及重复的次数求出来，复制到另一个表格中。

如图实例1－1所示。

图实例1-1

二、代码：

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

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 ：释放字典内存。

代码执行后如图实例1-2所示。

图实例1-2

mWfjYlKO.rar (11.46 KB, 下载次数: 503)

蓝桥玄霜 · 发表于 2010-10-18 13:49

实例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, "@", ""), ""

[a1].Resize(UBound(arr), 1) = arr

[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列中的所有的@都替换为空白，只剩下数字了。

代码详解的4代码执行后，如图实例3-1所示。

图实例3-1 示例

代码全部执行后如图实例3-2所示。

图实例3-2 示例

eYdqGfid.rar (27.84 KB, 下载次数: 445)

蓝桥玄霜 · 发表于 2010-10-18 13:49

实例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)

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句分别把字典的关键字数组转置后赋给相应的单元格区域。

代码执行后如图实例4-1所示。

图实例4-1 示例

山菊花版主用了一个字典对象就解决了上述问题。让我们来学习一下。

四、山菊花版主的代码：

Sub 拆分()

Dim pp1$, pp2$, nRow%, ds, Brr(), s(1 To 3) As Integer

Set ds = CreateObject("scripting.dictionary")

pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), Range("g1").End(xlDown))), ",")

pp2 = Join(WorksheetFunction.Transpose(Range(Range("h2"), Range("h1").End(xlDown))), ",")

nRow = Range("a1").End(xlDown).Row

Arr = Range("a1:a" & nRow)

ReDim Brr(1 To nRow, 1 To 3)

For i = 2 To nRow

If Not ds.Exists(Arr(i, 1)) Then

ds(Arr(i, 1)) = ""

If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then

s(1) = s(1) + 1

Brr(s(1), 1) = Arr(i, 1)

ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then

s(2) = s(2) + 1

Brr(s(2), 2) = Arr(i, 1)

Else

s(3) = s(3) + 1

Brr(s(3), 3) = Arr(i, 1)

End If

End Sub

五、代码详解

1、pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), _

Range("g1").End(xlDown))), ",") ：

这句代码用了两个VBA函数Join 和Transpose ，Range("g1").End(xlDown)从G1单元格往下直到最下面的单元格，遇到空白格就停止。因为本例的G14、G15单元格有另外的数据存在，如果还是用Range("g65536").End(xlUp)，那么就会把不需要的数据带进去，造成结果出错。Transpose 转置函数，前面已经介绍过了。Join函数是通过连接某个数组中的多个子字符串而创建的一个字符串，本句代码执行后得到pp1="MOTO, 诺基亚, 三星, 索爱"。

pp2一句同上句一样，得到另一个字符串。

2、nRow = Range("a1").End(xlDown).Row ：把A列最后一行不为空白的行数赋给整型变量nRow。

3、Arr = Range("a1:a" & nRow) ：把A列A1开始的有数据的单元格区域赋给变量Arr。

4、ReDim Brr(1 To nRow, 1 To 3) ：用于为动态数组变量Brr重新分配存储空间。第一维的下界从1到上界nRow，第二维从1到3。

5、For i = 2 To nRow ：从2到 nRow逐一循环。

6、If Not ds.Exists(Arr(i, 1)) Then ：如果字典ds中不存在关键字Arr(i, 1)

7、ds(Arr(i, 1)) = "" ：把Arr(i, 1)作为关键字加入字典ds。

8、If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then ：这里山版主用了比较运算符Like来比较pp1和取自Arr(i, 1)左边两个字符，再在前后加任意字符组成的字符串，如果满足条件为真，那么执行下面的语句。

9、s(1) = s(1) + 1 ：数组s的第一个元素+1以后赋给数组s的第一个元素。

10、Brr(s(1), 1) = Arr(i, 1) ：把这个关键字赋给第2维为1的另一个数组Brr，也就是我们要求的贸易机类。pp1字符串里都是贸易机类的品牌。

11、ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then ：同样，如果满足国产品牌类这个条件，那么执行下面的代码。

12、s(2) = s(2) + 1 ：数组s的第二个元素+1以后赋给数组s的第二个元素。

13、Brr(s(2), 2) = Arr(i, 1) ：把这个关键字赋给第2维为2的另一个数组Brr，也就是我们要求的国产品牌类。pp2字符串里都是国产品牌类的品牌。

14、s(3) = s(3) + 1 ：前如果条件都不满足时，数组s的第三个元素+1以后赋给数组s的第三个元素。

15、Brr(s(3), 3) = Arr(i, 1) ：把这个关键字赋给第3维为1的另一个数组Brr，也就是我们要求的其它品牌类。

16、Range("c2:e" & nRow) = Brr ：把数组Brr赋给[c2]单元格开始的区域中。

附件均见上一帖子。本想放在一个帖子里的，不料放不下，只能分2帖。

[此贴子已经被作者于2010-10-21 10:46:21编辑过]

蓝桥玄霜 · 发表于 2010-10-18 13:50

实例5 前期绑定的字典实例

一、问题的提出：

有多列多行数据，其中有重复的行，要求编写一段代码，求得不重复的行数据。

如图实例5-1所示。

图实例5-1 示例

二、代码：

Sub 保留原数据() ‘by:ldy888

‘前期绑定，需先引用c:\windows\system32\scrrun.dll

Dim d As New Dictionary,t

For i = 2 To 5

Set d(Cells(i, 1) & "") = Range(Cells(i, 1), Cells(i, 4))

[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t))

End Sub

三、代码详解

1、Dim d As New Dictionary, t ：本段代码需要先引用微软的脚本运行时库Microsoft Scripting Runtime，可在VBE窗口，从菜单－工具－引用，然后勾选Microsoft Scripting Runtime，或者点击浏览，在添加引用对话框中选择c:\windows\system32\scrrun.dll，并打开，确定。完成引用。在本声明语句中把字典d声明为New Dictionary。这就是”前期绑定”了。上面的实例用的是创建对象语句：

Set d = CreateObject("Scripting.Dictionary")，称为”后期绑定”。不需要先引用脚本运行时库。

2、Set d(Cells(i, 1) & "") = Range(Cells(i, 1), Cells(i, 4)) ：把单元格对象加入字典，它对应的项是同一行的单元格区域。注意，这里用了Set，和前面的几例不一样哦。如果用Typename(d(Cells(i, 1) & ""))，得到的是一个Range对象。这里的Cells(i, 1) & ""也可以用Cells(i, 1).Value来代替。

3、t=d.items ：把字典d中存在的所有的关键字对应的项赋给变量t。得到的是一个一维数组，下限为0，上限为d.Count-1。

4、[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t)) ：这句用了两次工作表转置函数Transpose之后赋给A11单元格开始的区域中。

代码执行后如图实例5-2所示。

YKDyVhGr.rar (70.1 KB, 下载次数: 506)

蓝桥玄霜 · 发表于 2010-10-18 13:56

实例6 多条件复杂汇总

一、问题的提出：

有一个表格，需要对其中多个条件相同的数量进行合并汇总，并且要有汇总的明细数据，要求编写一段代码，实现这样的合并同类项的要求。

二、代码：

Sub kf2() ‘by:oobird

Dim d As Object, a, b, j%, w!

Dim ss$, n%, x

Me.UsedRange.Offset(3, 0) = ""

a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp))

Set d = CreateObject("scripting.dictionary")

ReDim b(1 To UBound(a), 1 To 8)

For i = 1 To UBound(a)

ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8)

If Not d.Exists(ss) Then

n = n + 1

d.Add ss, n

b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4)

b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9)

Else

b(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9)

End If

x = Split(b(i, 7), "+")

For j = 0 To UBound(x)

w = w + x(j)

Next j

b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0

End Sub

三、代码详解

1、Dim d As Object, a, b, j%, w! ：Dim语句中的j% 等同于Dim j As Integer。w! 等同于Dim w As Single。类似的还有ss$ 等同于Dim ss As String。还有双精度数据类型Double的类型声明字符为#、货币数据类型Currency的类型声明字符为@。

2、Me.UsedRange.Offset(3, 0) = "" ：Offset是Range对象的属性，Offset(3, 0)的第一个参数是行数；第二个参数是列数，意思是往下偏移3行，列不变。Me是活动工作表，相当于Activesheet; UsedRange为已经使用的单元格区域。本句可解释为：清空第3行以下的单元格。

3、a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp)) ：把原始数据所在的表1自A4以下的I列最后的非空单元格区域的值赋给变量a。

4、Set d = CreateObject("scripting.dictionary") ：创建字典对象d。

5、ReDim b(1 To UBound(a), 1 To 8) ：根据数组a的大小重新声明数组b。

6、For i = 1 To UBound(a) ：在1 和数组a第一维的上界值之间逐一循环。

7、ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) ：把多个条件比例、位置、项目名称、大系统编号、小系统编号和相同楼层数用连接符号&连成一个字符串，然后赋给变量ss。

8、If Not d.Exists(ss) Then ：If…Then结构利用了字典的Exists方法和Not来判断：如果字典d里面不存在ss表示的关键字，那么执行下面的语句。

9、n = n + 1 ：把变量n增加1以后仍然赋给n。

10、d.Add ss, n ：把ss的值作为关键字，n的值作为对应的项一起加入字典d中。n的值实际是关键字的位置次序，如n=1时是第一个关键字；n=2时是第二个关键字。

11、b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4) ：为了使代码看起来简短一些，可以用冒号”:”把多个语句连成一行。4个语句分别给数组b的各个元素赋以对应的值。

12、b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) ：与上述的11条相同。

13、否则执行这句：b(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9) ：d(ss)等于关键字对应的项，在本例里等于对应的n的值。本句是把图纸长度a(i, 9)用"+"连起来赋给数组b，这样就得到了长度明细一栏数据。

14、For i = 1 To d.Count ：在字典关键字数目中逐一循环。

15、x = Split(b(i, 7), "+") ：运用VBA函数Split把b(i, 7)（长度明细）按照"+"分割，返回一个下标从零开始的一维数组x。如果要详细了解Split函数的，可参见我的另一篇文章“常用VBA函数精选合集”。http://club.excelhome.net/thread-387253-1-1.html

16、For j = 0 To UBound(x) ：在上面的x数组之间逐一循环。

17、w = w + x(j) ：把变量w加x(j)数组的一个元素以后仍然赋给w。实际得到x数组的累加值。

18、b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 ：w求出后经过按要求计算得到的值赋给数组b的第8列元素。（数量列）另一句把变量w置0。避免在新一次的循环中误加进去。

19、[b4].Resize(n, 8) = b ：最后把数组b赋给B4开始的单元格区域。

代码执行后如图实例6-1所示。

附件请见实例5.

[此贴子已经被作者于2010-10-22 10:12:41编辑过]

蓝桥玄霜 · 发表于 2010-10-18 13:57

实例7 字典法排序

一、问题的提出：

A列B列是按顺序排列的全部股票代码和股票名称，C列D列和E列F列是另外按条件筛选出来的无序的数据，
要求编写一段代码，将它们排列到与A列相同的股票行里面。

代码执行前如图实例7-1所示。

图
实例7-1示例

二、代码：

Private Sub CommandButton1_Click() ‘by:oobird

Dim d As Object, rng, i%, j%, arr

Set d = CreateObject("Scripting.Dictionary")

rng = Range("a3:f" & [a65536].End(xlUp).Row)

ReDim arr(1 To UBound(rng), 1 To 4)

For i = 1 To UBound(rng)

d(CStr(rng(i, 1))) = i

Next i

For j = 3 To 5 Step 2

For i = 1 To Cells(65536, j).End(xlUp).Row - 2

If d(CStr(rng(i, j))) <> "" Then

arr(d(CStr(rng(i, j))), j - 2) = rng(i, j)

arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1)

End If

Next i

Next j

[c3].Resize(UBound(rng), 4) = arr

End Sub

三、代码详解

1、Dim d As Object, rng, i%, j%, arr
：声明各个变量。

2、Set d = CreateObject("Scripting.Dictionary") ：创建字典对象d。

3、rng = Range("a3:f" & [a65536].End(xlUp).Row) ：把A列到F列的单元格区域的值赋给变量rng。

4、ReDim arr(1 To UBound(rng), 1 To 4) ：根据数组rng的大小重新声明动态数组变量的大小，这里是按最大数量来声明，可避免因声明得小了而导致代码出错。

5、For i = 1 To UBound(rng)
：在rng数组中逐一循环。

6、d(CStr(rng(i, 1))) = i
：把A列的股票代码的值用VBA转换函数CStr转换成字符串以后作为关键字，因为如果不作处理有时候遇到00开始的数据，可能会失去前面的0。股票代码在数组中的行位置i作为关键字对应的项，一起加入字典d。

7、For j = 3 To 5 Step 2
：前面的循环得到了整个字典，下面这两个循环用来与字典中的关键字比对而重新排位。Step 2是循环的步长，j=3执行以后，j=3+2=5，从而跳过j=4了。呵呵，这是For…Next循环结构的基础知识，说多了。

8、For i = 1 To Cells(65536, j).End(xlUp).Row – 2 ：因为C列和E列的最后一个非空单元格的位置不一样，所以用了Cells(65536, j).End(xlUp).Row在循环中分别得到这两列的最后一个非空单元格的行数，由于数组rng是从第3行开始的，为了与下面引用的rng数组对应，所以需要减去2。全句是在C列和E列中逐一循环。

9、If d(CStr(rng(i, j))) <> "" Then
：rng(i, j)是C列或者E列的股票代码，本句是如果这个股票代码关键字对应的项不等于空的时候，执行下面的代码。

10、arr(d(CStr(rng(i, j))), j - 2) = rng(i, j)
：d(CStr(rng(i, j)))=i见上述6的解释，表示数组arr的第1维，相当于行；j-2是随着j=3的时候，j-2=1；j=5的时候j-2=3，相当于数组列的参数。把相应的股票代码赋给相同股票代码的第1列或者是第3列。

11、arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1)
：把相应的股票名称赋给相同股票代码的第2列或者是第4列。

12、[c3].Resize(UBound(rng), 4) = arr
：把数组arr赋给C3开始的单元格区域。

代码执行后如图实例7-2所示。

图
实例7-2示例

r6CS3eCC.rar (75.34 KB, 下载次数: 515)

raulerini · 发表于 2010-10-18 18:12

好东西，先收藏。期待续集！！

老糊涂 · 发表于 2010-10-18 20:21

好东西，谢谢

		自动登录	找回密码
密码			注册

[分享] 常见字典用法集锦及代码详解

前言

字典的简介

评分

回复：（蓝桥玄霜）常见字典用法集锦及代码详解

实例1 普通常见的求不重复值问题实例2 求多表的不重复值问题

实例1 普通常见的求不重复值问题

实例3

实例3 A列中显示1 ~ 1000中被6除余1和余5 的数字

实例4

实例4 拆分数据不重复

实例5

实例5 前期绑定的字典实例

实例6

实例6 多条件复杂汇总

实例7

实例7 字典法排序

评分

评分

[分享] 常见字典用法集锦及代码详解

前言

字典的简介

评分

回复：（蓝桥玄霜）常见字典用法集锦及代码详解

实例1 普通常见的求不重复值问题 实例2 求多表的不重复值问题

实例1 普通常见的求不重复值问题

实例3

实例3 A列中显示1 ~ 1000中被6除余1和余5 的数字

实例4

实例4 拆分数据不重复

实例5

实例5 前期绑定的字典实例

实例6

实例6 多条件复杂汇总

实例7

实例7 字典法排序

评分

评分

实例1 普通常见的求不重复值问题实例2 求多表的不重复值问题