2022年VBA字典用法小记 .pdf

《2022年VBA字典用法小记 .pdf》由会员分享，可在线阅读，更多相关《2022年VBA字典用法小记 .pdf（43页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。

1、VBA 字典用法小记十分鄙视那些将 蓝桥玄霜大大的成果上传后还要收取下载券的做法，本来想直接上传一份大大的原版， 可是百度文档提示已经有重复的文档，没办法，只好自己修改一下，在上传，想无私奉献的大大致敬！ ！ ！ ！ ！ ！ ！ ！ ！ ！常用语句：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后面没有写数据类型，默认就是可变型数据类型(Vari

2、ant)。也有写成Dim d As Object 的，声明为对象。2、Set d = CreateObject(Scripting.Dictionary)：创建字典对象， 并把字典对象赋给变量d。 这 是 最 常 用 的 一 句 代 码 。 所 谓 的 “ 后 期 绑 定 ”。 用 了 这 句 代 码 就 不 用 先 引 用c:windowssystem32scrrun.dll了。3、d.Add a, Athens ：添加一关键字” a” 和对应于它的项” Athens” 。4、d.Add b, “ Belgrade” ：添加一关键字” b” 和对应于它的项” Belgrade” 。5、d.A

3、dd 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 名师资料总结 - - -精品资料欢迎下载 -

4、- - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 43 页 - - - - - - - - - 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 ：如果字典中存在

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

6、.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) ：这句代码是很常用很经典的代码，所以这里要多说一些。Re

7、size 是 Range对象的一个属性，用于调整指定区域的大小，它有两个参数，第一个是行数，本例是d.Count，指的是字典中关键字的数量，整本字典中有多少个关键字，本例d.Count=3，因为有 3 个关键字。呵呵，是不是说多了。第二个是列数，本例是1。这样左边的意思就是：把一个单元格B1 调整为以B1 开始的一列单元格区域，行数等于字典中关键字的数量d.Count，就是把单元格B1 调整为单元格区域 B1：B3 了。右边的k 是个一维数组，是水平排列的，我们知道Excel 工作表函数里面有个转置函数 Transpose，用它可以把水平排列的置换成竖向排列。但是在 VBA 中不能直接使用该工

8、作表函数，需要通过Application 对象的 WorksheetFunction 属性来使用它。所以完整的写法名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 43 页 - - - - - - - - - 是 Application. WorksheetFunction.Transpose(k)，中间的WorksheetFunction 可省略。现在可以解释这句代码了：把字典中所有的关键字赋给以B1 单元格开始的单元格区域中。Items 方法返回一个数组，其中包含了一个

9、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 ： 把字典中所有

10、的关键字对应的项赋给变量t。 得到的也是一个一维数组，下限为 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 对象中删除的关键字，

11、项目对相关联。说明如果所指定的关键字，项目对不存在，那么将导致一个错误。常用语句：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 个关键字了。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3

12、 页，共 43 页 - - - - - - - - - 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 ：清除字典中所有的数据。也就是清空这字典，然后可以添加新的关键字和项，

13、形成一本新字典。字典对象的属性有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)。一

14、般写法为Dim n As Integer 。 Integer 的类型声明字符为百分比号(% )。2、n = d.Count ：把字典中所有的关键字的数量赋给变量n。本例得到的是3。Key 属性在 Dictionary 对象中设置一个key。object.Key(key) = newkey 参数：object 必选项。总是一个字典(Dictionary) 对象的名称。key 必选项。被改变的key 值。newkey 必选项。替换所指定的key 的新值。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - -

15、 - - 第 4 页，共 43 页 - - - - - - - - - 说明如果在改变一个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” 。It

16、em 属性在一个Dictionary 对象中设置或者返回所指定key 的 item。对于集合则根据所指定的 key 返回一个item。读 /写。object.Item(key) = newitem 参数object 必选项。总是一个Dictionary 对象的名称。key 必选项。与要被查找或添加的item 相关联的key。newitem 可选项。仅适用于Dictionary 对象； newitem 就是与所指定的key 相关联的新值。说明如果在改变一个key 的时候没有找到该item，那么将利用所指定的newitem 创建一个新的key。如果在试图返回一个已有项目的时候没有找到key，那么将

17、创建一个新的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:/ CompareMode属性设置或者返回在Dictionary 对象中进行字符串关键字比

18、较时所使用的比较模式。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 43 页 - - - - - - - - - object.CompareMode = compare 参数object 必选项。总是一个Dictionary 对象的名称。compare 可选项。如果提供了此项， compare 就是一个代表比较模式的值。可以使用的值是0 (二进制 )、1 (文本 ), 2 (数据库 )。说明如果试图改变一个已经包含有数据的Dictionary 对象的比较模式， 那么将

19、导致一个错误。常用语句：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 。如果设置为

20、vbBinaryCompare（值为 0） ，则执行二进制比较，即区分关键字的大小写，此种情况下关键字” b” 和” B” 被认为是不一样的。2、d.Add B , Baltimore ：添加一关键字” B” 和对应于它的项” Baltimore ” 。由于前面已经设置了比较模式为文本模式，不区分关键字的大小写，即关键字” b” 和” B” 是一样的，此时发生错误添加失败，因为字典中已经存在” b” 了，字典中的关键字是唯一的，不能添加重复的关键字。实例 1 普通常见的求不重复值问题一、问题的提出 ：表格中人员有很多是重复的，要求编写一段代码，把重复的人员姓名以及重复的次数求出来，复制到另一个

21、表格中。如图实例 11 所示。论坛网址： http:/ 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 43 页 - - - - - - - - - 图实例 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) F

22、or i = 2 To UBound(Arr) d(Arr(i, 3) = d(Arr(i, 3) + 1 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 声明为长

23、整型变量。也可以写为Dim Myr As Long 。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 7 页，共 43 页 - - - - - - - - - Long的类型声明字符为(& )。 Arr 后面没有写明数据类型，默认就是可变型数据类型(Variant)。2、Set d = CreateObject(Scripting.Dictionary)：创建字典对象， 并把字典对象赋给变量d。 这 是 最 常 用 的 一 句 代 码 。 所 谓 的 “ 后 期 绑 定 ”。 用 了

24、 这 句 代 码 就 不 用 先 引 用c:windowssystem32scrrun.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 列最后一行不为空白的

25、单元格区域的值赋给变量Arr 。这样 Arr 就是个二维数组了，用数组替代单元格引用可对执行代码的速度提高很多很多。5、For i = 2 To UBound(Arr) ：ForNext 循环结构，从2 开始到数组的最大上界值之间循环。因为数组的第一行是表头。Ubound 是 VBA函数，返回数组的指定维数的最大可用上界。6、d(Arr(i, 3) = d(Arr(i, 3) + 1 ：Arr(i,3) 在本例是姓名列，也就是关键字列，举个例子，假如Arr(i,3)= ” 张三 ” ，这句代码的意思就是把关键字” 张三 ” 加入字典， d(key)等于关键字 key 对应的项，每出现一次这个关

26、键字，它的项的值就增加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) = A

27、pplication.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

28、= Nothing ：释放字典内存。代码执行后如图实例1-2 所示。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 8 页，共 43 页 - - - - - - - - - 图实例 1-2 实例 2 求多表的不重复值问题一、问题的提出 ：一工作簿里面有3 张工作表上，每张表格的A 列都是姓名列，所有这些姓名中有些是重复的，要求编写一段代码，在另一个工作表上显示不重复的姓名。如图实例 21 所示。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - -

29、- - - - - - 名师精心整理 - - - - - - - 第 9 页，共 43 页 - - - - - - - - - 图实例 2-1 这个问题也很适合用字典来解决。代码如下：二、代码 ：Sub bcfz() Dim i&, Myr&, Arr Dim d, k, t, Sht As Worksheet Set d = CreateObject(Scripting.Dictionary) For Each Sht In Sheets If Sht.Name Sheet4 Then Myr = Sht.a65536.End(xlUp).Row Arr = Sht.Range(a2:a &

30、 Myr) For i = 1 To UBound(Arr) d(Arr(i, 1) = Next End If Next k = d.keys Sheet4.a3.Resize(d.Count, 1) = Application.Transpose(k) Set d = Nothing End Sub 三、代码详解名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 10 页，共 43 页 - - - - - - - - - 1、For Each Sht In Sheets ：For E

31、achNext 循环结构，这种形式是VBA 特有的，用于对对象的循环非常适用。意思是在所有的工作表中依次循环。2、If Sht.Name Sheet4 Then ：如果这个工作表的名字不等于” Sheet4” 时执行下面的代码。3、Myr = Sht.a65536.End(xlUp).Row ： 求得这个工作表A 列有数据的最后一行的行数，把它赋给变量Myr 。这里用了长整型数据类型(Long) ，数据范围最大可到2,147,483,647，是为了避免数据很多的时候会超出整型数据类型(Integer)而出错，因为整型数据类型数据范围最大只到32,767。4、Arr = Sht.Range(a2

32、:a & Myr) ：把 A 列数据赋给数组Arr 。5、For i = 1 To UBound(Arr) ：ForNext 循环结构，从1 开始到数组的最大上限值之间循环。 Ubound 是 VBA 函数，返回数组的指定维数的最大值。6、d(Arr(i, 1) = “” ：这句代码的意思就是把关键字Arr(i,1) 加入字典，关键字对应的项为空，相当于字典中的这个关键字没有解释。和d.Add Arr(i,1), 的效果相同，只是代码更简洁一些。7、k=d.keys ：把字典d 中存在的所有的关键字赋给变量k。得到的是一个一维数组，下限为 0，上限为 d.Count-1。Keys 是字典的方法

33、，前面已经讲过了。8、Sheet4.a3 .Resize(d.Count, 1) = Application.Transpose(k) ：把字典d 中所有的关键字赋给表4 以 a3 单元格开始的单元格区域中。代码执行后如图实例2-2 所示。图实例 2-2 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 11 页，共 43 页 - - - - - - - - - 实例 3 A 列中显示 1 1000 中被 6 除余 1 和余 5 的数字一、问题的提出 ：有 1、2、31000 一千个数

34、字，要求编写一段代码，在工作表的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 a:a.

35、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

36、 - 3) = 2，Abs 是取绝对值函数。另一个VBA 函数 IIf 是根据判断条件返回结果，和IfThen 判断结果类似；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 = W

37、orksheetFunction.Transpose(Filter(dic.keys, )： 这句代码的内容分为3 部分，第 1 部分是Filter(dic.keys, )其中的 Filter 是一个 VBA 函数，VBA 函数就是可以直接在代码中使用的，我们平常使用的函数叫工作表函数，如Sum、Sumif、Transpose 等等。 Filter函数要求在一维数组中筛选出符合条件的另一个一维数组，式中的 dic.keys 正是一个一维数组。这里的筛选条件是” ” ，也就是把字典关键字中含有的关键字筛选出来组成一个新的一维数组，其下标从零开始。第 2 部分是用工作表函数Transpose 转置

38、这个新的一维数组，工作表函数的使用在前面keys 方法一节已经说过了；第2 部分是把转置以后的值赋给数组变量 Arr 。呵呵，狼版主的代码是短了，我的解释却太长了。4、a1.Resize(UBound(arr), 1) = arr：把数组 Arr 赋给 a1单元格开始的区域中。5、a:a.Replace , ：把 A 列中的所有的 都替换为空白，只剩下数字了。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 12 页，共 43 页 - - - - - - - - - 代码详解的4 代码

39、执行后，如图实例3-1 所示。图实例 3-1 示例代码全部执行后如图实例3-2 所示。图实例 3-2 示例实例 4 拆分数据不重复一、问题的提出 ：有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。二、代码 ：名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 13 页，共 43 页 - - - - - - - - - Sub caifen() Dim Myr&, Arr, x& Dim d, d1, d2, i&, j& Set d = CreateO

40、bject(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 UBoun

41、d(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

42、(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(

43、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(国产两汉字的首字母)。名师资料总结 - - -精品资料欢迎下载

44、- - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 14 页，共 43 页 - - - - - - - - - 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 个参数存在。本句的意思是

45、如果找到贸易机品牌的话，执行下面的代码。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(U

46、Bound(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.Transpos

47、e(Range(Range(g2), Range(g1).End(xlDown), ,) pp2 = Join(WorksheetFunction.Transpose(Range(Range(h2), Range(h1).End(xlDown), ,) nRow = Range(a1).End(xlDown).Row 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 15 页，共 43 页 - - - - - - - - - Arr = Range(a1:a & nRow) ReDim

48、 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) = A

49、rr(i, 1) End If End If Next Range(c2:e & nRow) = Brr 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) ，那么就会把不需要

50、的数据带进去，造成结果出错。 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 重新分配