EXCELVBA常见字典用法集锦及代码详解(全).pdf

《EXCELVBA常见字典用法集锦及代码详解(全).pdf》由会员分享，可在线阅读，更多相关《EXCELVBA常见字典用法集锦及代码详解(全).pdf（53页珍藏版）》请在三一文库上搜索。

1、常见字典用法集锦及代码详解 前言 凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各 样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以 很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。 凡 是 上 过EH论 坛 的 想 学 习VBA里 面 字 典 用 法 的 ， 几 乎 都 看 过 研 究 过 northwolves狼版主、 oobird 版主的有关字典的精华贴和经典代码。我也是从这里接触 到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化 的高手们致敬，从他们那里我们也学到了很多，也得到了提高

2、。 字典对象只有4 个属性和6 个方法，相对其它的对象要简洁得多，而且容易理解使 用方便，功能强大，运行速度非常快，效率极高。深受大家的喜爱。 本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想 要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。 给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确 实理解得不对，还会贻误他人。所以下面的这些注释如果有不对或者不妥当的地方，请 大家跟帖时指正批评，及时改正。 字典的简介 字典（ Dictionary ）对象是微软Windows 脚本语言中的一个很有用的对象。 附带提一下，有名的正则表达式

3、（RegExp）对象和能方便处理驱动器、文件夹和文件 的（ FileSystemObject ）对象也是微软Windows 脚本语言中的一份子。 字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项 （Item ）联合组成。就好像一本字典书一样，是由很多生字和对它们对应的注解所组 成。比如字典的“典”字的解释是这样的： “典”字就是具有唯一性的关键字，后面的解释就是它的项，和“典”字联合组成一对 数据。 常用关键字英汉对照： Dictionary 字典 Key 关键字 Item 项，或者译为条目 字典对象的方法有6 个： Add 方法、 Keys 方法、 Items 方法、

4、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“, “B

5、elgrade“ d.Add “c“, “Cairo“ 代码详解 1、 Dim d ：创建变量，也称为声明变量。变量d 声明为可变型数据类型 (Variant)，d 后面没有写数据类型，默认就是可变型数据类型(Variant)。也有写成Dim d As Object 的，声明为对象。 2、 Set d = CreateObject(“Scripting.Dictionary“)：创建字典对象，并把字典对象赋给 变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用 c:windowssystem32scrrun.dll了。 3、 d.Add “a“, “Athens“ ：添

6、加一关键字” a” 和对应于它的项” Athens” 。 4、 d.Add “b“, “ Belgrade” ：添加一关键字” b” 和对应于它的项” Belgrade” 。 5、 d.Add “c“, “ Cairo ” ：添加一关键字” c” 和对应于它的项” Cairo” 。 3 Exists 方法 如果Dictionary 对象中存在所指定的关键字则返回true，否则返回false。 object.Exists(key) 参数 object 必选项。总是一个Dictionary 对象的名称。 key 必选项。需要在Dictionary 对象中搜索的key 值。 常用语句： Dim d,

7、 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.E

8、xists(“c“) Then ：如果字典中存在关键字” c” ，那么执行下面的语句。 3、 msg = “指定的关键字已经存在。“ ：把 “指定的关键字已经存在。“字符串赋给 变量 msg。 4、 Else ：否则执行下面的语句。 5、 msg = “指定的关键字不存在。“ ：把 “指定的关键字不存在。“字符串赋给变量 msg。 6、 End If ：结束 If ElseEndif 判断。 Keys 方法 返回一个数组，其中包含了一个Dictionary 对象中的全部现有的关键字。 object.Keys( ) 其中object 总是一个Dictionary 对象的名称。 常用语句： Dim

9、 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.

10、Resize(d.Count,1)=Application.Transpose(k) ：这句代码是很常用很经典的 代码，所以这里要多说一些。 Resize 是 Range 对象的一个属性，用于调整指定区域的大小，它有两个参数，第 一个是行数，本例是d.Count，指的是字典中关键字的数量，整本字典中有多少个关键 字，本例d.Count=3，因为有3 个关键字。呵呵，是不是说多了。 第二个是列数，本例是1。这样左边的意思就是：把一个单元格B1 调整为以B1 开始的一列单元格区域，行数等于字典中关键字的数量d.Count，就是把单元格B1 调整 为单元格区域B1：B3 了。 右边的k 是个一维数组

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

12、ems( ) 其中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 ：把字典中所有的关键字对应的项赋给变

13、量t。得到的也是一个一维 5 数组，下限为0，上限为d.Count-1。这是数组的默认形式。 3、 C1.Resize(d.Count,1)=Application.Transpose(t) ：有了上面Keys 方法的解释这 句代码就不用多说了，就是把字典中所有的关键字对应的项赋给以C1 单元格开始的单 元格区域中。 Remove 方法 Remove 方法从一个Dictionary 对象中清除一个关键字，项目对。 object.Remove(key ) 其中object 总是一个Dictionary 对象的名称。 key 必选项。 key 与要从Dictionary 对象中删除的关键字，项目对

14、相关联。 说明 如果所指定的关键字，项目对不存在，那么将导致一个错误。 常用语句： 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

15、.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 属 性。 Cou

16、nt 属性 返回一个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 的类型声明字符为百分比号(

17、% )。 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.Dictio

18、nary“) d.Add “a“, “Athens“ 7 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 必选

19、项。总是一个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.

20、Add “b“, “Belgrade“ d.Add “c“, “Cairo“ MsgBox d.Item(“c“) 代码详解 1、 d.Item(“c“) ：获取指定的关键字” c” 对应的项。 2、 MsgBox ：是一个VBA函数，用消息框显示。如果要详细了解MsgBox 函 数的，可参见我的另一篇文章“常用VBA 函数精选合集” 。-387253-1-1.html CompareMode 属性 设置或者返回在Dictionary 对象中进行字符串关键字比较时所使用的比较模式。 object.CompareMode = compare 参数 object 必选项。总是一个Dictionar

21、y 对象的名称。 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 “, “

22、Baltimore“ 代码详解 1、 d.CompareMode = vbTextCompare ：设置字典的比较模式是文本，在这种比较 模式下不区分关键字的大小写，即关键字” b” 和 ” B” 是一样的。vbTextCompare 的值为 1，所以上式也可写为d.CompareMode =1 。如果设置为vbBinaryCompare （值为0） ， 则执行二进制比较，即区分关键字的大小写，此种情况下关键字” b” 和” B” 被认为是不一 样的。 2、 d.Add “ B “, “ Baltimore“ ：添加一关键字” B” 和对应于它的项” Baltimore ” 。由于 前面已经设

23、置了比较模式为文本模式，不区分关键字的大小写，即关键字” b” 和” B” 是一 样的，此时发生错误添加失败，因为字典中已经存在” b” 了，字典中的关键字是唯一 的，不能添加重复的关键字。 实例 1 普通常见的求不重复值问题 一、 问题的提出 ： 表格中人员有很多是重复的，要求编写一段代码，把重复的人员姓名以及重复的次 数求出来，复制到另一个表格中。 如图实例11 所示。 论坛网址： -637004-1-1.html 9 图实例 1-1 二、代码 ： Sub cfz() Dim i UsedRange为已经使用的单元格区域。本句可解释为：清空第3 行以下 的单元格。 3、a = Sheet1

24、.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)

25、 & a(i, 8) ：把多个条件比例、位置、项 目名称、大系统编号、小系统编号和相同楼层数用连接符号&连成一个字符串，然 25 后赋给变量ss。 8、If Not d.Exists(ss) Then ： IfThen 结构利用了字典的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

26、, 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,

27、 9)用“+“ 连起来赋给数组 b，这样就得到了长度明细一栏数据。 14、For i = 1 To d.Count ：在字典关键字数目中逐一循环。 15、x = Split(b(i, 7), “+“)：运用VBA 函数 Split 把 b(i, 7)（长度明细）按照“+“ 分 割，返回一个下标从零开始的一维数组x。如果要详细了解Split 函数的，可参见我 的另一篇文章“常用VBA 函数精选合集” 。-387253-1-1.html 16、For j = 0 To UBound(x) ：在上面的x 数组之间逐一循环。 17、w = w + x(j) ：把变量w 加 x(j) 数组的一个元素以后

28、仍然赋给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 所示。 图 实例 6-1 示例 实例 7 字典法排序 一、 问题的提出 ： A 列 B 列是按顺序排列的全部股票代码和股票名称，C 列 D 列和 E 列 F 列是另外 按条件筛选出来的无序的数据，要求编写一

29、段代码，将它们排列到与A 列相同的股票 行里面。 代码执行前如图实例7-1 所示。 27 图 实例 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(r

30、ng(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：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=

31、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 所示。 29 图 实例 7-2 示例 实例 8 2 级动态数据有效性问题 一、 问题的提出 ： A 列是源名称，中间有空格，B 列为各个源名称对应的数目不同的代号，C 列是目 标名称来源于源

32、名称，要求在C 列设置不重复的、没有空格的数据有效性供选择；同时 D 列目标代号，要求随着C 列选择的目标名称的不同，提供对应的代号供选择，是为第 2 级数据有效性。 代码执行前如图实例8-1 所示。 图 实例 8-1 示例 二、代码 ： Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count 1 Then Exit Sub If Target.Column 3 Then Exit Sub Dim d, i&, Myr&, Arr, r%, Arr1(), cp$, ks&, js&, j& Se

33、t d = CreateObject(“Scripting.Dictionary“) Myr =b65536.End(xlUp).Row Arr = Range(“a2:b“ & Myr) If Target.Column = 3 Then For i = 1 To UBound(Arr) If Arr(i, 1) “ Then For i = 1 To UBound(Arr) If Arr(i, 1) r Then js = Arr1(i + 1) - 1 Else js = Myr - 1 End If ks = Arr1(i) For j = ks To js cp = cp & Arr

34、(j, 2) & “,“ Next End If Next i cp = Left(cp, Len(cp) - 1) With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=cp End With Target = Split(cp, “,“)(0) End If Set d = Nothing End Sub 三、代码详解 1、Private Sub Worksheet_SelectionChange(ByV

35、al Target As Range)：本例用的是工 作表选择变化事件，只要鼠标点击单元格都会激活这个事件。Private 可译为私有的，限 制了这段代码只能在指定的工作表里有效。参数Target 声明为单元格区域对象，有了关 键字 ByVal，说明可以按值传递参数。 2、If Target.Count 1 Then Exit Sub ：由于是鼠标点击单元格都会激活这个事件,所 以最好要作一些限制，使得你能避免点击了不需要激活事件的地方而激活本事件产 生错误。本句是如果目标单元格的数目大于1 就退出本过程。这样当你点选了多个 单元格的时候，过程运行了这句代码就会结束过程了。 3、If Targ

36、et.Column 3 Then Exit Sub ：再加一个限制， 如果目标单元格的列不是3 列（ C 列）也不是4 列（ D 列）的话就退出过程。 4、接着的四句代码分别是声明变量、创建字典对象、B 列最后一个非空单元格的 行数以及把单元格区域的值赋给数组变量等等与前面的实例相同。请注意这里选择 了 B 列求最后一个非空单元格的行数，是因为A 列各数据之间有空格，如果选择 A 列，就会遗漏一些数据。 5、If Target.Column = 3 Then：现在分两种情况判断，如果点击的目标单元格是C 列的，那么执行下面的代码。 6、If Arr(i, 1) “ Then：否则如果目标单元

37、格是 D 列的，并且同行C 列单元格不是空的情况下，执行这下面的代码。Offset 属 性的详解可见前面实例6 的第 2 条解释。 12、For i = 1 To UBound(Arr)：在数组 Arr 之间逐一循环。 13、If Arr(i, 1) r Then：如果 i 不等于 r 时执行下面的代码。 20、js = Arr1(i + 1) 1：把下一个源名称所在的行数-1 以后赋给变量js，这样来求 得每一个源名称的开始和结束的位置。 21、js = Myr 1：否则就是最后一行1 的只赋给变量js（最后一个源名称在数 组中的位置） 。 22、ks = Arr1(i)：把数组的值赋给变量

38、ks：得到每一个源名称的起始位置。 23、For j = ks To js：从每一个源名称的起始位置到结束位置逐一循环。 24、cp = cp & Arr(j, 2) & “,“：把相应的代号与逗号连接起来组成的字符串赋给变量 cp。 25、cp = Left(cp, Len(cp) - 1)：用了两个VBA 函数 Left 和 Len 把去掉末位的逗 号。 26、With语句解释同上，为D 列单元格设置了第2 级数据有效性。 27、Target = Split(cp, “,“)(0) ：按照问题的第3 个要求，在目标名称确定后，在目标 代号相应位置自动生成目标名称的第一个代号。因为Split

39、 得到的是一个以0 为下 界的一维函数，所以它的第一个元素就用(0)来表示。 代码执行后如图实例8-2 所示。 图 实例 8-2 示例 实例 9 字典取行数，数组重新赋值 一、 问题的提出 ： 要求编写一段代码，求得B 列不重复的名字，其相应的A 列和 D 列分别用 “ “连起 来，而相应的E 列 F列的数值分别相加汇总。 代码执行前如图实例9-1 所示。 35 图 实例 9-1 示例 二、代码 ： Sub yy() by:Zamyi Dim d As New Dictionary, R Dim k, i&, j& R = Sheet1.UsedRange k = 1 For i = 2 To

40、 UBound(R) R(i, 2) = Replace(Replace(R(i, 2), “（“, “(“), “）“, “)“) If d.Exists(R(i, 2) Then R(d(R(i, 2), 1) = R(d(R(i, 2), 1) & “ “ & R(i, 1) R(d(R(i, 2), 4) = R(d(R(i, 2), 4) & “ “ & R(i, 4) R(d(R(i, 2), 5) = Val(R(d(R(i, 2), 5) + R(i, 5) R(d(R(i, 2), 6) = Val(R(d(R(i, 2), 6) + R(i, 6) Else k = k +

41、 1 d(R(i, 2) = i For j = 1 To UBound(R, 2) R(k, j) = R(i, j) Next End If Next With Sheet2 .Cells.ClearContents . = xlNone .a1:F1.Resize(d.Count + 1) = R .a1:F1.Resize(d.Count + 1).Borders.LineStyle = 1 End With Set d = Nothing End Sub 三、代码详解 1、R = Sheet1.UsedRange：把表 1 的已经使用了的单元格区域的值赋给变量R。 2、k = 1 ：

42、变量 k 赋初值 1。 3、For i = 2 To UBound(R) ：由于第一行是表头，所以从第2 行开始循环。 4、R(i, 2) = Replace(Replace(R(i, 2), “（“, “(“), “）“, “)“)：由于源数据中用了不统一的 括号，所以加了这句把里面中文括号统一替换为英文括号。这句用了两次VBA函 数 Replace，一次替换前半个，另一次替换后半个。Replace 函数有6 个参数，详细 请查阅 VBA 帮助文件。如果在这里解释，篇幅太长了，也冲淡了字典的主题。 5、If d.Exists(R(i, 2) Then ：这句用字典的Exists 方法进行判断

43、，如果字典中存在 R(i, 2) 这个关键字，那么执行下面的代码。 6、这里先解释，Else如果上面的判断不成立，即字典中不存在这个关键字时，要 执行下面的代码。 7、k = k + 1：变量 k+1 以后再赋给k。 8、d(R(i, 2) = i：公司名字作为关键字，对应的项是它所在的行，把它们加入字典 d。 9、For j = 1 To UBound(R, 2)：知道了这个关键字所在的行，下面这个循环就是重新 给数组同一行的各个元素赋值。UBound(R, 2) 是用 VBA 函数 Ubound 求得数组R 的 第 2 维的最大上界。比如本例R 数组第 1 维的最大上界是8，有 8 行数据

44、；而第2 维的最大上界是6，有 6 列数据。本循环j 就是从第1 列到第 6 列依次循环。 10、R(k, j) = R(i, j)：把 i 行 j 列的数组元素赋给k 行 j 列的 R 数组元素。 11、R(d(R(i, 2), 1) = R(d(R(i, 2), 1) & “ “ & R(i, 1)：再回来说如果R(i, 2) 这个关键字存 在，则执行这条代码。在这之前，这关键字已经加入字典了，它的同一行的各个数 组元素也重新赋过值了，所以根据问题的要求，把A 列的数据用 “ “ 连起来再赋给A 37 列这个数组元素。 12、R(d(R(i, 2), 4) = R(d(R(i, 2), 4

45、) & “ “ & R(i, 4)：D 列数据同上。 13、R(d(R(i, 2), 5) = Val(R(d(R(i, 2), 5) + R(i, 5)：E 列数据要相加，这里用了VBA 函数 Val，把 E 列数组元素转为数值以后相加汇总。下句类同。 14、With Sheet2：With 语句，前面介绍过的。 15、.Cells.ClearContents：清空表2 所有的数据。 Cells 是工作表对象的属性，指 工作表所有的单元格；ClearContents 是它的方法，清除里面的公式、数据，但是保 留格式设置。 16、. = xlNone：清除表2 所有的边框。Borders 是

46、Cells 的属性，意思是单元格的 边框； LineStyle 是边框的属性，为边框的线型，它有直线、虚线、点划线等等，这 里取值 xlNone 是清除边框。 17、.a1:F1.Resize(d.Count + 1) = R：把数组R 的值赋给表2A1 单元格开始的区 域。 18、.a1:F1.Resize(d.Count + 1).Borders.LineStyle = 1：给这些单元格添加边框，线 型为直线。 代码执行后如图实例9-2 所示。 图 实例 9-2 示例 实例 10 先字典求得行后显示整行数据 一、 问题的提出 ： 有 3 列数据，要求编写一段代码，如果C 列名次、 A 列主

47、排相同时，根据B 列次排 最大的只保留一行。 解题思路：先对3 列数据按主要关键字名次_升序，次要关键字主排_升序，第3 关 键字次排 _降序进行排序，然后运用字典，以” 名次 |主排 ”作为关键字，它所在的行作为 关键字的项加入字典，最后根据行引用相对的单元格值。 代码执行前如图实例10-1 所示。 图 实例 10-1 示例 二、代码 ： Sub pmc() Dim i&, Myr&, Arr Dim d, x, rng Application.ScreenUpdating = False Set d = CreateObject(“Scripting.Dictionary“) Sheet1

48、.Activate Myr = a65536.End(xlUp).Row Range(“A1:C“ & Myr).Sort Key1:=Range(“C2“), Order1:=xlAscending, Key2:=Range( _ 39 “A2“), Order2:=xlAscending, Key3:=Range(“B2“), Order3:=xlDescending, _ Header:=xlYes Arr = Range(“a2:c“ & Myr) For i = 1 To UBound(Arr) x = Arr(i, 1) & “|“ & Arr(i, 3) If Not d.exi

49、sts(x) Then d.Add x, i + 1 End If Next e:g.ClearContents e2.Resize(d.Count, 1) = Application.Transpose(d.items) For Each rng In e2.Resize(d.Count, 1) rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value Next Set d = Nothing Application.ScreenUpdating = True End Sub 三、代码详解 1、Application.ScreenUpdating = False：关闭屏幕更新。关闭屏幕更新可加快宏的 执行速度。请记住当宏结束执行时，将ScreenUpdating 属性设回到True。 2、Range(“A1:C“ & Myr).Sort Key1:=Range(“C2“), Order1:=xlAscending, Key2:=Range(“A2“), Order2:=xlAscending, Key3:=Range(“B2“), Order