EXCEL VBA 常见字典用法集锦及代码详解(全).doc

Four short words sum up what has lifted most successful individuals above the crowd: a little bit more.-author-dateEXCEL VBA 常见字典用法集锦及代码详解(全)EXCEL VBA 常见字典用法集锦及代码详解(全)常见字典用法集锦及代码详解前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。凡是上过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:windowssystem32scrrun.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 ElseEndif判断。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单元格开始的单元格区域中。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函数精选合集”。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”了，字典中的关键字是唯一的，不能添加重复的关键字。实例1 普通常见的求不重复值问题一、问题的提出：表格中人员有很多是重复的，要求编写一段代码，把重复的人员姓名以及重复的次数求出来，复制到另一个表格中。如图实例11所示。论坛网址：图 实例1-1 二、代码：Sub cfz()Dim i&, Myr&, ArrDim d, k, tSet d = CreateObject("Scripting.Dictionary")Myr = Sheet1.a65536.End(xlUp).RowArr = Sheet1.Range("a1:g" & Myr)For i = 2 To UBound(Arr) d(Arr(i, 3) = d(Arr(i, 3) + 1Nextk = d.keyst = d.itemsSheet2.Activatea2.Resize(d.Count, 1) = Application.Transpose(k)b2.Resize(d.Count, 1) = Application.Transpose(t)a1.Resize(1, 2) = Array("姓名", "重复个数")Set d = NothingEnd Sub三、代码详解1、Dim i&, Myr&, Arr ：变量i和Myr声明为长整型变量。 也可以写为 Dim Myr As Long 。Long 的类型声明字符为(&)。Arr后面没有写明数据类型，默认就是可变型数据类型(Variant)。2、Set d = CreateObject("Scripting.Dictionary")：创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用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列最后一行不为空白的 单元格区域的值赋给变量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对应的项，每出现一次这个关键字，它的项的值就增加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 实例2 求多表的不重复值问题一、问题的提出：一工作簿里面有3张工作表上，每张表格的A列都是姓名列，所有这些姓名中有些是重复的，要求编写一段代码，在另一个工作表上显示不重复的姓名。如图实例21所示。图 实例2-1 这个问题也很适合用字典来解决。代码如下：二、代码：Sub bcfz()Dim i&, Myr&, ArrDim d, k, t, Sht As WorksheetSet 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" & Myr) For i = 1 To UBound(Arr) d(Arr(i, 1) = "" Next End IfNextk = d.keysSheet4.a3.Resize(d.Count, 1) = Application.Transpose(k)Set d = NothingEnd Sub三、代码详解1、For Each Sht In Sheets ：For EachNext循环结构，这种形式是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: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是字典的方法，前面已经讲过了。8、Sheet4.a3 .Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的关键字赋给表4以a3单元格开始的单元格区域中。代码执行后如图实例2-2所示。图 实例2-2 实例3 A列中显示1 1000中被6除余1和余5 的数字一、问题的提出：有1、2、31000一千个数字，要求编写一段代码，在工作表的A列显示这些数被6除余1和余5的数字。二、代码：Sub 余1余5() by:狼版主Dim dic As Object, i As Long, arrSet dic = CreateObject("Scripting.Dictionary")For i = 1 To 1000dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "", ""), ""Nextarr = WorksheetFunction.Transpose(Filter(dic.keys, "")a1.Resize(UBound(arr), 1) = arra:a.Replace "", ""Set dic = NothingEnd 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是根据判断条件返回结果，和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 = 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 示例实例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).RowArr = Range("a2:a" & Myr)Range("c2:e" & Myr).ClearContentsmy = 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 xRange("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