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

Excel 常见字典用法集锦及代码详解5实例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 Thend(Arr(x, 1)) = ""GoTo 100End IfNext iFor j = 0 To UBound(gc)If InStr(Arr(x, 1), gc(j)) > 0 Thend1(Arr(x, 1)) = ""GoTo 100End IfNext jd2(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三个字典对象。

ExcelVBA——字典实⽤技巧最近写了⼀些⼩功能，对字典有了进⼀步的理解，太强⼤了！个⼈最近⽤过的字典应⽤有这么⼏个，写下来防⽌⾃⼰忘~同时⽅便⼤家⼀、查找重复⾏【原理】利⽤字典的exist⽅法，将数据加⼊字典时判断⼀下，如果已经存在，就说明当前数据为重复数据，应该删除【⽰例代码】Sub chongfu() '查重Dim i As LongDim endline As Long'定义⼯作表长度变量endline = Sheet3.Range("A30000").End(xlUp).Row '获取⼯作表Sheet3有数据的最后⼀⾏⾏号Set d = CreateObject("scripting.dictionary") '设定字典dFor i = endline To2Step -1'从最后⼀⾏开始，依次把各个字段拼接到⼀起（注意，这⾥我的需求是这⼏个字段拼在⼀起的字符串不允许重复，因此我先拼接再判重）'把所有字符串拼接到数组⾥If Sheet3.Cells(i, 2) <> ""Then'判断该⾏是否为空If IsError(Sheet3.Cells(i, 2)) = False Then'如果关键单元格不是#N/A，则进⼊字典设置x = Sheet3.Cells(i, 2) '******************设置赋给字典的变量,即需要去重的单元格！*******************If Not d.Exists(x) Then'判断是否重复d(x) = x '如果不重复，则把x定为itemElseSheet3.Rows(i & ":" & i).Delete Shift:=xlUp '如果字典中已有对应的item，则该⾏重复，删除重复的⾏End IfEnd IfEnd IfNextEnd Sub【效果展⽰】⼆、查找关键字【原理】最常见的应⽤，根据key来查找对应的item【⽰例代码】Sub DicFind() '查找编号对应的数据endline = Sheet3.Range("E100000").End(xlUp).Row '获取待匹配的数据区域长度Set d = CreateObject("Scripting.Dictionary") '设置字典dArr = Sheet3.Range("A2:B26975") '获得字典数据For i = 1To UBound(Arr) '设置sheet3 A列为字典关键字key，B列为字典关键字对应的值（item）If Arr(i, 1) <> ""Then'当A列不为空时，将item装⼊数组x = Arr(i, 1) '想以哪⼀列为关键字查找结果，就把x设置成哪⼀列的单元格d(x) = Arr(i, 2)ElseExit For'A列为空时，退出for循环End IfNextBrr = Sheet3.Range("$E$2:$F$" & endline) '将待查找的数据放⼊数组For j = 1To UBound(Brr)x = Brr(j, 1) '将E列的编号设为keyIf d.Exists(x) Then'如果字典中有对应的item，则将item写⼊数组brrBrr(j, 2) = d(x) '把查找到的item写⼊brr，这⾥对应F列End IfNextSheet3.Range("$E$2:$F$" & endline) = Brr '将匹配好的数据写回单元格End Sub【效果展⽰】建设中。

VBA字典用法集锦及案例代码详解dadaVBA字典用法集锦及案例代码详解前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。

有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。

凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。

我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。

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

深受大家的喜爱。

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

给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。

所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。

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

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

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。

就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。

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

常用关键字英汉对照：2字典的简介Dictionary 字典Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

VBA字典用法集锦及案例代码详解VBA中的字典是一种集合数据类型，它可以用来存储键值对。

字典中的键是唯一的，而值可以重复。

通过键可以快速查找和访问对应的值。

以下是一些常见的VBA字典用法和案例代码的详解：1.创建字典可以使用Dictionary对象来创建一个新的字典对象。

例如：```vbaDim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")```2.添加键值对使用Add方法可以向字典中添加键值对。

例如：```vbadict.Add "Key1", "Value1"dict.Add "Key2", "Value2"```3.访问值可以使用键来访问字典中的对应的值。

例如：```vbaDim value As Stringvalue = dict("Key1")```4.更新值使用键来更新字典中的值。

例如：```vbadict("Key1") = "NewValue"```5.删除键值对可以使用Remove方法来删除字典中的键值对。

例如：```vbadict.Remove "Key1"```6.遍历字典可以使用For Each循环来遍历字典中的键值对。

例如：```vbaDim key As VariantDim value As VariantFor Each key In dict.Keysvalue = dict(key)'执行其他操作Next key```7.检查键是否存在可以使用Exists方法来检查字典中是否包含指定的键。

例如：```vbaIf dict.Exists("Key1") Then'执行操作End If```8.获取字典中的键和值可以使用Keys和Items属性来获取字典中的所有键和值。

VBA 字典法学习与例子Sub 二列多行求和()Dim arr1, dic, x, arr2(1 To 10, 1 To 2), m%, k% '定义变量Set dic = CreateObject("Scripting.dictionary") '后期绑定引用字典arr1 = Range("A1").CurrentRegion '把单元区域装到数组arr1For x = 2 To UBound(arr1, 1) '循环数组arr1的行If dic.exists(arr1(x, 1)) Then '判断数组元素arr1(x,1)在字典关键词里是否存在，m = dic(arr1(x, 1)) '如果存在，把关键词arr1(x,1)的条目读出来，在原来的'基础上累加，通过读取关键词arr1(x,1)的条目，找到在数组arr2那一行上累加arr2(m, 2) = arr2(m, 2) + arr1(x, 2) '在数组arr2第m行，第2列上累加Else '如果关键词arr1(x,1)不存在，那么k = k + 1 '计数dic(arr1(x, 1)) = k '把数组arr1(x,1)装到字典dic里，条目装一个k,'这个k的作用来给数组arr2中找到存放那一行arr2(k, 1) = arr1(x, 1) '把数组arr1里的第x行第1列装到数组arr2的第k行，第1列arr2(k, 2) = arr1(x, 2) '把数组arr1里的第x行第2列装到数组arr2的第k行，第2列End IfNext xRange("E1:F" & Rows.Count) = "" '清空区域，用来存放新的数据[E1:F1] = Array("产品名称", "数量") '填充表头[E2].Resize(k, 2) = arr2 '把数组arr2读到单元格区域End Sub2020-8-31Sub 多列多行汇总()Dim dic, arr1, x%, MySt, k%, arr2(1 To 15, 1 To 3), y%, m%Set dic = CreateObject("Scripting.dictionary")arr1 = Range("A1").CurrentRegionFor x = 2 To UBound(arr1, 1)MySt = arr1(x, 1) & arr1(x, 2)If dic.exists(MySt) Thenm = dic(MySt)arr2(m, 3) = arr2(m, 3) + arr1(x, 3)Elsek = k + 1dic(MySt) = kFor y = 1 To 3arr2(k, y) = arr1(x, y)Next yEnd IfNext xRange("E1:G" & Rows.Count) = ""[E1:G1] = Array("产品名称", "款号", "数量")[E2].Resize(k, 3) = arr2End Sub产品名称款号数量产品名称款号数量WS-10 A 1 WS-10 A 100 WS-10 B 2 WS-10 B 2 WS-10 C 3 WS-10 C 3 VZ-45 A 1 VZ-45 A 1000 VZ-45 B 2 VZ-45 B 2 VZ-45 C 3 VZ-45 C 3 WS-10 A 99VZ-45 A 999Sub 删除重复数据－根据A列内容，保存表格内数据最上面一行，删除下面的重复行Set d = CreateObject("scripting.dictionary")Set Rng = Nothingarr = [a1].CurrentRegionApplication.ScreenUpdating = FalseFor j = 1 To UBound(arr)If d.exists(arr(j, 1)) ThenIf Rng Is Nothing ThenSet Rng = Cells(j, 1)ElseSet Rng = Union(Rng, Cells(j, 1))End IfElsed(arr(j, 1)) = ""End IfNext jIf Not Rng Is Nothing Then Rng.EntireRow.Delete Application.ScreenUpdating = TrueEnd Sub客户姓名月份消费数量A1 1 10A2 1 10A1 1 10A2 1 10A3 2 10A4 2 10A5 2 10A3 2 10A4 2 10A5 2 10A6 3 10A7 3 10A6 3 10A7 3 10A8 4 10A4 4 10A8 4 10A4 4 10A5 5 10A6 5 10A5 5 10A6 5 10A1 6 10A10 6 10A1 6 10A10 6 10A8 7 10A9 7 10A8 7 10A9 7 10Sub 根据内容查询对应数据Dim dic, arr1, arr2, arr3, arr4(1 To 100, 1 To 2), x& y& k& '定义变量Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典Range("H2:I100") = "" '清空原有的数据arr1 = Range("A1").CurrentRegion '把区域装到数组arr1arr2 = Range("F1").CurrentRegion '把区域装到数组arr2For x = 2 To UBound(arr1, 1) '循环数组arr1的行dic(arr1(x, 1) & "|" & arr1(x, 2)) = arr1(x, 3) & "|" & arr1(x, 4)'由于两个条件，而关键字只能装一个条件，所以用&把两件条件连起来，中间用"|"分开'同理，由于有二个条目，而一个关键词只能对应一个条目，因此我也是用&连接起来，中间用"|"分开'这样就解决了多行多列装入到字典，间接地突破了字典只能装两列Next xFor y = 2 To UBound(arr2, 1) '循环数组arr2的行arr3 = VBA.Split(dic(arr2(y, 1) & "|" & arr2(y, 2)), "|")'根据arr2(y, 1) & "|" & arr2(y, 2)）读字典dic里的条目出来，其实它的条目就是我们'刚才arr1后面两列的用"|"的数据，然后用函数Split切开，根据"|"，赋值给数组arr3 '大家一定要明白，Split通过"|"切开，赋值给数组arr3 数组arr3是一维数组，且它的上标从0开始k = k + 1 '累加karr4(k, 1) = Val(arr3(0)) '把切开出来的数据放到数组arr4里arr4(k, 2) = Val(arr3(1))Next y[H2].Resize(k, 2) = arr4Sub 透视表示的汇总()Dim arr1, dica, dicb, x& k& y& m& n& a& b& arr2() '定义相关的变量Set dica = CreateObject("Scripting.Dictionary") '创建两个字典Set dicb = CreateObject("Scripting.Dictionary")arr1 = Range("A1").CurrentRegion '把区域装入数组arr1For x = 2 To UBound(arr1, 1) '循环数组arr1的行If Not dicb.exists(arr1(x, 2)) Then '如果关键字arr1(x,2)不存在，那么'就把它装入字典dicb里，目的就是为了去重k = k + 1 '累加k，目的给dicb做条目dicb(arr1(x, 2)) = k + 1 '这里为什么还要加1呢？原因在数组arr2里第一列是产品名称'第二放型号"大号"，第三列放型号"中号"，第四列放型号"小号"，第五列是行汇总End IfNext xReDim arr2(1 To 100, 1 To dicb.Count + 2)For y = 2 To UBound(arr1, 1)If dica.exists(arr1(y, 1)) Then '如果字典dica里关键字arr1(y,1)存在，那么就累加arr2数据列a = dica(arr1(y, 1)) '字典dica里关键词arr1(y,1)的条目读出来，目的在是在数组arr2'里找到累加数组arr2那一行，而数组arr2有五列，具体累加到那一列呢？b = dicb(arr1(y, 2)) '字典dicb里的关键词arr1(y,2)的字典读出来，来定位到具体累加到数组arr2那一列arr2(a, b) = arr2(a, b) + arr1(y, 3)arr2(a, 5) = arr2(a, 2) + arr2(a, 3) + arr2(a, 4) '同一行三种型号相加Elsem = m + 1 '累加m，目的给dica做条目和数组arr2定位dica(arr1(y, 1)) = m '把arr1(y,1)装入字典dic2，条目为mn = dicb(arr1(y, 2))arr2(m, 1) = arr1(y, 1) '把数组arr1的第一列装入arr2里的第一列arr2(m, n) = arr1(y, 3) '把数组arr1的第三列装入arr2里的第n列End IfNext yRange("F1:J" & Rows.Count) = ""[F1] = "产品名称"[G1].Resize(1, dicb.Count) = dicb.keys[G1].Offset(0, dicb.Count) = "行总计"[F2].Resize(dica.Count, dicb.Count + 2) = arr2End Sub。

vba中字典用法字典是一种用于存储键值对的数据结构，在VBA中经常被用来解决需要快速查找和访问数据的问题。

本文将介绍VBA中字典的用法，包括字典的创建、添加、删除和查找等操作。

一、字典的创建要使用字典，首先需要声明和初始化一个字典变量。

可以使用“Dim”语句声明一个字典变量，并使用“CreateObject”函数初始化它，示例代码如下：Dim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")二、字典的添加字典的添加操作指的是向字典中添加键值对。

使用“Add”方法可以向字典中添加一个键值对，示例代码如下：dict.Add "key1", "value1"在字典中，键必须是唯一的，如果添加重复的键，会触发错误。

可以使用“Exists”方法检查键是否已存在于字典中，示例代码如下：If Not dict.Exists("key1") Thendict.Add "key1", "value1"三、字典的删除字典的删除操作指的是从字典中删除一个键值对。

可以使用“Remove”方法将指定的键值对从字典中移除，示例代码如下：dict.Remove "key1"如果要清空整个字典，可以使用“RemoveAll”方法，示例代码如下：dict.RemoveAll四、字典的查找字典的查找操作指的是根据键查找对应的值。

可以使用“Item”方法获取指定键的值，示例代码如下：Dim value As Variantvalue = dict("key1")在查找时，如果指定的键不存在于字典中，会触发错误。

可以使用“Exists”方法检查键是否存在于字典中，示例代码如下：If dict.Exists("key1") ThenDim value As Variantvalue = dict("key1")五、其他常用操作除了添加、删除和查找，字典还提供了其他一些常用的操作方法。

vba字典的用法VBA字典的用法什么是VBA字典？VBA字典是一种用于存储和管理键值对的数据结构。

它类似于Excel中的单元格范围，通过键值对的形式进行数据存储和访问。

创建字典对象通过CreateObject函数可以创建一个字典对象。

Dim dict As ObjectSet dict = CreateObject("")添加键值对使用Add方法来向字典对象添加键值对。

"key1", "value1""key2", "value2"访问字典中的值可以通过键来访问字典中的值。

Dim value As Stringvalue = dict("key1")判断键是否存在可以使用Exists方法判断指定的键是否存在于字典中。

If ("key1") Then' 键存在的处理逻辑End If删除键值对使用Remove方法可以删除指定键的键值对。

"key1"循环遍历字典可以使用For Each循环来遍历字典中的键值对。

Dim key As VariantFor Each key In"Key: " & key, "Value: " & dict(key)Next key字典的属性和方法除了上述基本用法外，字典对象还提供了一些其他常用的属性和方法：•Count：获取字典中键值对的数量。

•Keys：获取字典中所有键的集合。

•Items：获取字典中所有值的集合。

•RemoveAll：删除字典中的所有键值对。

•Exists：判断指定的键是否存在于字典中。

总结VBA字典是一种方便实用的数据结构，能够快速存储和访问键值对。

通过本文的介绍，你可以掌握VBA字典的基本用法，进而在VBA编程中灵活运用字典对象。

VBA中的字典（Dictionary）是一种特殊的对象，用于存储键值对（Key-Value Pair）。

使用字典可以很方便地存储、查询和管理数据。

下面是一些VBA字典的基本用法：
创建字典对象
vba
Dim myDict As Object
Set myDict = CreateObject("Scripting.Dictionary")
向字典中添加键值对
vba
myDict.Add "key1", "value1"
myDict.Add "key2", "value2"
获取字典中的值
vba
Dim value As Variant
value = myDict("key1")
判断键是否存在
vba
If myDict.Exists("key1") Then
' do something
End If
删除字典中的键值对
vba
myDict.Remove "key1"
清空字典中的所有键值对
vba
myDict.RemoveAll()
除了以上基本用法，VBA字典还有很多高级用法，比如遍历字典中的所有键值对、合并多个字典等。

可以根据实际需求使用相应的语法和方法来实现。

vba中字典的用法VBA中的字典结构是一种非常有用的数据结构，它可以用于存储和操作键值对。

在本文中，我们将深入介绍VBA中字典的用法和实现。

一、字典结构的定义在VBA中，字典结构可以通过创建Scripting.Dictionary对象来实现。

我们可以使用以下代码定义一个新的字典结构：```Dim dict As New Scripting.Dictionary```二、添加和删除字典项我们可以使用以下代码向字典中添加新的项：```dict.Add key, value```其中key是要添加的键，value是要添加的值。

如果键已经存在于字典中，将会产生一个错误。

在这种情况下，我们可以使用以下代码更新现有的字典项：```dict(key) = new_value```我们可以使用以下代码从字典中删除一个项：```dict.Remove key```其中key是要删除的键。

三、访问字典项我们可以使用以下代码从字典中获取一个项：```value = dict(key)```其中key是要获取值的键，value是键对应的值。

如果键不存在于字典中，将会产生一个错误。

在这种情况下，我们可以使用以下代码检查键是否存在：```If dict.Exists(key) Thenvalue = dict(key)Else' 处理键不存在的情况End If```四、遍历字典中的项我们可以使用以下代码遍历字典中的所有键值对：```For Each key In dictvalue = dict(key)' 处理每一个键值对Next```我们也可以使用以下代码获取所有的键：```keys = dict.Keys```五、总结在本文中，我们深入介绍了VBA中的字典结构的用法和实现。

我们学习了如何添加、删除、访问和遍历字典中的项。

使用字典结构可以让我们更方便地处理键值对，从而提高代码的效率和可读性。

常见字典用法集锦及代码详解常见字典用法集锦及代码详解字典的简介字典（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 已经存在，那么将导致一个错误。

2字典的简介常用语句：Dim dSet d = CreateObject("Scripting.Dictionary")d.Add "a", "Athens"d.Add "b", "Belgrade"d.Add "c", "Cairo"代码详解1、Dim d ：创建变量，也称为声明变量。

变量d声明为可变型数据类型(Variant)，d后面没有写数据类型，默认就是可变型数据类型(Variant)。

Excel常见字典用法集锦及代码详解7实例6 多条件复杂汇总一、问题的提出：有一个表格，需要对其中多个条件相同的数量进行合并汇总，并且要有汇总的明细数据，要求编写一段代码，实现这样的合并同类项的要求。

二、代码：Sub kf2() ‘by:oobirdDim d As Object, a, b, j%, w!Dim ss$, n%, xedRange.Offset(3, 0) = ""a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp))Set d = CreateObject("scripting.dictionary")ReDim b(1 T o 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) Thenn = n + 1d.Add ss, nb(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)Elseb(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9)End IfNextFor i = 1 To d.Countx = Split(b(i, 7), "+")For j = 0 To UBound(x)w = w + x(j)Next jb(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0Next[b4].Resize(n, 8) = bEnd Sub三、代码详解1、Dim d As Object, a, b, j%, w! ：Dim语句中的j% 等同于Dim j As Integer。

vba字典的使用方法和作用
一、VBA字典的使用方法（1）第一步：创建字典对象 Dim Dict As New Scripting.Dictionary
（2）第二步：添加键/值对 Dict.Add Key:="One", Item:="First" Dict.Add Key:="Two", Item:="Second" Dict.Add Key:="Three", Item:="Third"
（3）第三步：读取键/值对 MsgBox Dict("One")
（4）第四步：遍历字典中的所有键/值对 For Each KVP In Dict MsgBox KVP & vbNewLine & Dict(KVP) Next
（5）第五步：判断字典是否包含某个键 If
Dict.Exists("One") Then MsgBox "One is in the dictionary" End If
（6）第六步：移除字典中的某个键/值对
Dict.Remove "One"
（7）第七步：清空字典 Dict.RemoveAll
二、VBA字典的作用（1）VBA字典可以用来存储和检索相关数据，它在程序中的作用类似于JavaScript中的Object。

（2）VBA字典可以用于快速检索数据，而不需要遍历数组或者循环。

（3）VBA字典可以用于保存复杂结构的数据，例如多维数组。

（4）VBA字典可以用于统计数据，例如统计单词出现的次数。

【跟我学ExcelVBA】第十一课：字典看到有朋友留言，说为什么没有更新了。

首先说声抱歉，这两天咳嗽咳得觉都睡不好，没有啥精神；而且，刚好有人定制了一个进销存系统，也忙着干活。

给大家展示一下成果，只要你努力学习，下面这个东西其实很简单。

今天，我们来扯一点中级知识！也许，大家看到了题目。

没错！就是字典！小伙伴们也许会想了，我们用过的字典还少么？什么中华字典、汉语拼音字典、中英文对照字典、康熙字典......嘿嘿，你想多了！那么，什么是字典呢？字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。

就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。

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

常用关键字英汉对照：Dictionary 字典Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

字典有4个属性：CompareMode ，Count ，Item ，Key那么，字典有什么用途呢，我们怎样使用字典？一、字典是存在于库文件Scrrun.dll中的，如果你不能使用字典，那么很大可能性就是你电脑上缺少这个库文件；二、字典的使用有前期绑定和后期绑定两种方法：1、前期绑定：首先，我们在VBE窗口中，点击工具-引用，并引用以下库文件：其次，在过程中输入以下代码，即可创建字典：Dim d As New Dictionary2、后期绑定：Dim d As ObjectSet D=CreateObject('Scripting.Dictionary')至于前期引用和后期绑定在使用上有什么区别，我们先不理。

四、Word vba常用语句100句1、系统参数(01) Application.Acti v ePrinter …获取当前打印机(02) Application.Height '当前应用程序文档的高度(03) Application.Width …当前应用程序文档的宽度(04) Application.Build …获取Word版本号和编译序号(05) Application.Caption …当前应用程序名(06) Application.DefaultSaveFormat '返回空字符串，表示Word文档(07) Application.DisplayRecentFiles '返回是否显示最近使用的文档的状态(08) Application.Documents.Count '返回当前打开的文档数(09) Application.FontNames.Count …返回当前可用的字体数(10) Application.Left …返回当前文档的水平位置(11) Application.MacroContainer.FullName '返回当前文档名，包括所在路径Application.M acroContainer.pach '返回当前文档路径Application.ActiveDocument.Path …获得文件的相对路径(12) Application.NormalT emplate.FullName '返回文档标准模板名称及所在位置(13) Application.RecentFiles.Count '返回最近打开的文档数目(14) Application.System.CountryRegion '返回应用程序所在的地区代码(15) Application.System.FreeDiskSpace …返回应用程序所在磁盘可用空间(16) Application.System.HorizontalResolution '返回显示器的水平分辨率(17) Application.System.V erticalResolution '返回显示器的垂直分辨率(18) nguageDesignation '返回系统所使用的语言(19) Application.System.MathCoprocessorInstalled …返回系统是否安装了数学协处理器(20) Application.System.OperatingSystem …返回当前操作系统名(21) Application.System.ProcessorT ype '返回计算机处理器名(22) Application.System.V ersion …返回操作系统的版本号(23) Application.T emplates.Count '返回应用程序所使用的模板数(24) erName '返回应用程序用户名(25) Application.V ersion …返回应用程序的版本号2、Documents/Document对象(26) ActiveDocument.AttachedT emplate.FullName '返回当前文档采用的模板名及模板所在位置(27) ActiveDocument.Bookmarks.Count '返回当前文档中的书签数(28) ActiveDocument.Characters.Count '返回当前文档的字符数(29) ActiveDocument.CodeName …返回当前文档的代码名称(30) ments.Count …返回当前文档中的评论数(31) ActiveDocument.Endnotes.Count '返回当前文档中的尾注数(32) ActiveDocument.Fields.Count '返回当前文档中的域数目(33) ActiveDocument.Footnotes.Count …返回当前文档中的脚注数(34) ActiveDocument.FullName '返回当前文档的全名及所在位置(35) ActiveDocument.H asPassword '当前文档是否有密码保护(36) ActiveDocument.H yperlinks.Count '返回当前文档中的链接数(37) ActiveDocument.Indexes.Count '返回当前文档中的索引数(38) ActiveDocument.ListParagraphs.Count '返回当前文档中项目编号或项目符号数(39) ActiveDocument.ListT emplates.Count '返回当前文档中使用的列表模板数(40) ActiveDocument.Paragraphs.Count '返回当前文档中的段落数(41) ActiveDocument.Password=XXX '设置打开文件使用的密码(42) ActiveDocument.ReadOnl y '获取当前文档是否为只读属性(43) ActiveDocument.Saved '当前文档是否被保存(44) ActiveDocument.Sections.Count '当前文档中的节数(45) ActiveDocument.Sentences.Count …当前文档中的语句数(46) ActiveDocument.Shapes.Count '当前文档中的形状数,图形？(47) ActiveDocument.Styles.Count '当前文档中的样式数(48) ActiveDocument.T ables.Count …当前文档中的表格数(49) ActiveDocument.T ablesOfAuthorities.Count …返回当前文档中的引文目录数(50) ActiveDocument.T ablesOfAuthoritiesCategories.Count …返回当前文档中引文目录类别数(51) ActiveDocument.T abl esOfContents.Count …返回当前文档中的目录数(52) ActiveDocument.T ablesOfFigures.Count '返回当前文档中的图表目录数3、Paragraphs/Paragraph对象(53) Selection.Paragraphs.Count '返回所选区域的段落数(54) Selection.Paragraphs.First '返回所选区域中的第一段(55) ActiveDocument.Paragraphs(1).LeftIndent '返回当前文档中第一段的左缩进值(56) ActiveDocument.Paragraphs(1).LineSpacing '返回当前文档中第一段的行距(57) ActiveDocument.Paragraphs(1).OutlineLevel …返回或设置当前文档中第一段的大纲级别.OutlineLevel = wdOutlineLevel2 …2级.OutlineLevel = wdOutlineLevel3 …3级(58) ActiveDocu ment.Paragraphs(1).RightIndent …返回当前文档中第一段的右缩进量(59) ActiveDocument.Paragraphs(1).SpaceBefore '返回当前文档中第一段的段前间距(60) ActiveDocument.Paragraphs(1).SpaceAfter …返回当前文档中第一段的段后间距(61) ActiveDocument.Paragraphs(1).Range.T ext '返回当前文档中第一段的内容(62) ActiveDocument.Paragraphs(1)Local '返回当前文档中第一段应用的样式名(63) ActiveDocument.Paragraphs(1).Range.Style.Description '返回当前文档中第一段所应用样式的详细描述(64) ActiveDocument.Paragraphs(1) '返回当前文档中第一段所应用样式的字体名(65) ActiveDocument.Paragraphs(1)FarEast '返回或设置一种东亚字体名(66) ActiveDocument.Paragraphs(1).Range.Style.Font.Size '返回或设置当前文档中第一段所应用样式的字体大小(67) ActiveDocument.Paragraphs(1).Range.Style.Font.Spacing '返回或设置字符间距(68) Selection.Words.Count '所选区域的字数Sentences对象(69) Selection.Sentences.Item(1) '所选区域中的第一句的内容Words对象(71) ActiveDocument.Words(1).Select '选择当前文档中的第一个词(72) ActiveDocument.Range.Words(1).InsertAfter "我爱你！" '在当前文档中的第一个词后插入“我爱你”4、Characters对象(73) Selection.Characters.Count '当前文档中所选区域的字符数(74) ActiveDocument.Paragraphs(1).Range.InsertParagraphAfter'在当前文档的第一段之后插入一个新段落5、Sections/Section对象(75) ActiveDocument.Sections.First '当前文档的第一节(76) ActiveDocument.Sections.First.PageSetup.BottomMargin '当前文档第一节所在页的底边距(77) ActiveDocument.Sections.First.PageSetup.LeftMargin '当前文档第一节所在页的左边距(78) ActiveDocument.Sections.First.PageSetup.RightM argin '当前文档第一节所在页的右边距(79) ActiveDocument.Sections.First.PageSetup.T opMargin '当前文档第一节所在页的顶边距(80) ActiveDocument.Sections.First.PageSetup.PaperSize '返回或设置当前文档第一节所在页的大小(81) ActiveDocument.Sections.First.PageSetup.PageHeight '返回或设置当前文档第一节所在页的高度(82) ActiveDocument.Sections.First.PageSetup.PageWidth '返回或设置当前文档第一节所在页的宽度(83) ActiveDocument.Sections.Add Range:=myRange '在当前文档中添加新节(84) ActiveDocument.Sections.Item(2) '当前文档中的第二节(85) st.Range.InsertAfter "文档结束！" '在当前文档中最后一节的结尾添加文字“文档结束！”6、Range对象(86) ActiveDocument.Range(Start:=0, End:=10) '表示当前文档前10个字符所组成的一个Range对象(87) Set myRange = Acti v eDocument.Range(Start:=ActiveDocument.Paragraphs(2).Range.Start, _End:=ActiveDocument.Paragraphs(4).Range.End) '将当前文档第2段至第4段设置为一个Range对象(88) ActiveDocument.Paragraphs(1).Range.Copy '复制当前文档中的第一段(89) Selection.CopyDocuments.Add.Content.Paste '复制所选内容到新文档中(90) ActiveDocument.Bookmarks("Book1").Copy Name:="Book2" '将Book2书签复制Book1书签标记的位置(91) Selection.GoT o What:=wdGoT oLine, Which:=wdGoT oAbsolute, Count:=4 '将所选内容移至文档中的第4行(92) Selection.GoT o What:=wdGoT oT able, Which:=wdGoT oNext '将所选内容移至下一个表格的第1个单元格(93) Selection.Range.AutoFormat '为所选内容套用格式(94) ActiveDocument.Content.Font.N ame = "Arial" '将当前文档的字体设置为斜体(95) ActiveDocument.Content.Select Selection.Delete '将当前文档中的内容删除其它(96) Documents.Add '添加一个新文档(97) Set myT able = ActiveDocument.T ables.Add(Selection.Range, 2, 2) '在当前文档所选区域添加一个2行2列的表格7、文件读写(98) Open "C:\my.txt" For Input As #1 '打开一个用于输入的文件并令其编号为1(99) Line Input #1, T extLine '读取被打开用于输入且编号为1的文件(100) Close #1 '关闭编号为1的文件一、新建Word引用需要首先创建一个对Word Application 对象的引用。

?常见字典用法集锦及代码详解前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。

有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。

凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves 狼版主、oobird版主的有关字典的精华贴和经典代码。

我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。

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

深受大家的喜爱。

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

给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。

所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。

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

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

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。

就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。

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

常用关键字英汉对照：Dictionary 字典|Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

excel vba 字典用法在ExcelVBA中，字典是一种非常有用的数据结构，它允许您通过键值对的方式存储和访问数据。

与数组不同，字典中的键可以是任何数据类型，而不仅仅是数字或字符串。

因此，字典通常用于需要按名称或其他非数字方式引用数据的情况。

使用字典的基本步骤是：1. 声明字典变量：使用Dim语句声明一个字典变量。

2. 实例化字典对象：使用Set语句创建一个新的字典对象。

3. 向字典添加元素：使用Add方法向字典中添加一个或多个元素。

4. 访问字典元素：使用Item方法通过键来访问字典中的元素。

5. 删除字典元素：使用Remove方法从字典中删除一个元素。

以下是一个简单的示例，演示了如何使用字典来存储和访问员工的姓名和薪水：Sub testDict()'声明字典变量Dim empDict As Object'实例化字典对象Set empDict = CreateObject('Scripting.Dictionary')'添加元素empDict.Add 'John', 50000empDict.Add 'Mary', 60000'访问元素Debug.Print empDict.Item('John') '输出50000'删除元素empDict.Remove 'Mary'End Sub上面的示例中，我们首先声明了一个名为empDict的字典变量。

然后，我们使用CreateObject函数创建了一个新的字典对象。

接下来，我们向字典中添加了两个元素，键为“John”和“Mary”，对应的值分别为50000和60000。

我们使用Item方法访问了键为“John”的元素，并输出了它的值。

最后，我们使用Remove方法从字典中删除了键为“Mary”的元素。

总结：Excel VBA中的字典是一种非常有用的数据结构，它允许您通过键值对的方式存储和访问数据。

VBA字典用法集锦及案例代码详解dadaVBA字典用法集锦及案例代码详解前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。

有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。

凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。

我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。

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

深受大家的喜爱。

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

给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。

所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。

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

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

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。

就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。

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

常用关键字英汉对照：2字典的简介Dictionary 字典Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。

1，特殊条件编号‘2012-9-3‘/forum.php?mod=viewthread&tid=914702&page=1#pid6271907 Sub lqxs()Dim Arr, i&, j&, jj&, n&, aa, bb, y, x$Dim d As New Dictionary, k, t, d1 As New Dictionary, t1Sheet1.Activate[e31:e5000].ClearContentsArr = [a1].CurrentRegionFor i = 31 To UBound(Arr)x = Arr(i, 4)y = Arr(i, 1) & "|" & Arr(i, 3)d(x) = d(x) & i & ","If d1.Exists(x) = False Then Set d1(x) = New Dictionaryd1(x)(y) = d1(x)(y) & i & ","Nextk = d.keyst = d.itemsFor i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)n = 0If InStr(t(i), ",") Thenaa = Split(t(i), ",")For j = 0 To UBound(aa)y = Arr(aa(j), 1) & "|" & Arr(aa(j), 3)n = n + 1t1 = d1(k(i))(y)t1 = Left(t1, Len(t1) - 1)If InStr(t1, ",") Thenbb = Split(t1, ",")For jj = 0 To UBound(bb)Cells(bb(jj), 5) = nNextj = j + UBound(bb)ElseCells(t1, 5) = nEnd IfNextEnd IfNextEnd Sub2，列表框3级数据有效性‘2012-9-4‘/thread-716135-1-1.htmlDim d1 As New DictionaryDim d2 As New DictionaryPrivate Sub ComboBox1_Click()ComboBox2.ClearComboBox3.ClearComboBox2.List = d1(ComboBox1.Text).ItemsEnd SubPrivate Sub ComboBox2_Click()ComboBox3 = ""ComboBox3.List = d2(ComboBox1.Text & ComboBox2.Text).Items End SubPrivate Sub UserForm_Initialize()arr = Sheet1.Range("a3:f" & Sheet1.[a65536].End(3).Row)For i = 1 To UBound(arr)a = arr(i, 1) & "":b = arr(i, 3) & "":c = arr(i, 6) & ""x = arr(i, 1) & arr(i, 3)If d1.Exists(a) = False Then Set d1(a) = New Dictionary d1(a)(b) = bIf d2.Exists(x) = False Then Set d2(x) = New Dictionary d2(x)(c) = cNextComboBox1.List = d1.KeysEnd Sub3，填表‘2012-9-19‘/thread-922624-1-1.htmlDim d As New DictionaryDim d1 As New DictionarySub 填充()Dim xm, rkb, rkkm, rlkm, rlxm, r, sckm, km, sSheet2.Activate[b:c].ClearContentsrkb = Sheets("任课表").Range("b2:bi16")xm = Sheets("绩效名单").Range("a2:a241")rkkm = Sheets("任课表").Range("a2:a16")For i = 1 To UBound(rkb)For j = 1 To UBound(rkb, 2)If d.exists(rkb(i, j)) = False Then Set d(rkb(i, j)) = New Dictionaryd(rkb(i, j))(rkkm(i, 1)) = rkkm(i, 1)Next jNext ik = d.Keysk1 = d(k(0)).itemsFor x = 1 To UBound(xm)If d.exists(xm(x, 1)) Thens = d(xm(x, 1)).itemsIf IsArray(s) ThenCells(x + 1, 2).Resize(1, UBound(s) + 1) = sElseCells(x + 1, 2) = sEnd IfEnd IfNextSet d = NothingEnd Sub4，2级字典嵌套‘2013-2-21‘/thread-984445-1-1.htmlSub lqxs()Dim Arr, i&, x, yDim d, k, tSet d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) + 1Nextk = d.keyst = d.items:For i = 2 To UBound(Arr)If d.exists(Arr(i, 1)) Then Cells(i, 3) = d(Arr(i, 1)).CountNextEnd Sub‘2013-1-22‘/thread-974297-1-1.htmlSub lqxs()Dim Arr, i&, j&, n&, ttDim d, k, t, d1, x, y, k1Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet2.ActivateArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1)y = Left(Arr(i, 3), 1)d(x) = d(x) + 1If d1.Exists(x) = False Then Set d1(x) = CreateObject("Scripting.Dictionary") d1(x)(y) = d1(x)(y) + 1Nextk = d1.keyst = d1.items: n = 4: tt = 0For i = 0 To UBound(k)Cells(n, 1) = "小计"Cells(n, 2) = k(i)Cells(n, 3) = t(i).Counttt = tt + t(i).Countk1 = t(i).keysFor j = 0 To UBound(k1)n = n + 1Cells(n, 2) = k(i)Cells(n, 3) = k1(j)Cells(n, 4) = d1(k(i))(k1(j))Nextn = n + 1NextCells(3, 3) = ttEnd Sub5，3级字典嵌套‘2012-1-23‘/forum.php?mod=viewthread&tid=974963&page=2#pid6676611 Sub lqxs()Dim Arr, i&, Arr1, x$, n&, y&, Brr, r%, Brr1(), r2%, Brr2()Dim d, k, t, d1, k1, t1, k2, kk, a, b, c, cp$Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet3.Activate[a2:d50000].ClearArr1 = Sheet1.[a1].CurrentRegionArr = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr)a = Arr(i, 4):b = Arr(i, 3)d(b) = aNextd.RemoveAllFor i = 2 To UBound(Arr1)a = Arr1(i, 4): c = Arr1(i, 7)b = Split(Arr1(i, 3), "]")(1)cp = a & "," & bIf a <> "" ThenIf d.Exists(a) = False Then Set d(a) = CreateObject("Scripting.Dictionary")d(a)(b) = bIf d1.Exists(cp) = False ThenSet d1(cp) = CreateObject("Scripting.Dictionary")End Ifd1(cp)(c) = d1(cp)(c) + 1End IfNextk = d.keys: k1 = d1.keyst = d.items: t1 = d1.items: n = 2For i = 0 To UBound(k)k2 = t(i).keysCells(n, 1) = k(i)For j = 0 To UBound(k2)Cells(n, 2) = k2(j)x = k(i) & "," & k2(j)kk = d1(x).keysFor y = 0 To UBound(kk)If d1(x)(kk(y)) <> 0 ThenCells(n, 3) = kk(y)Cells(n, 4) = d1(x)(kk(y))n = n + 1End IfNextNextNextBrr = [a1].CurrentRegionFor i = 2 To UBound(Brr)If Brr(i, 1) <> "" Thenr = r + 1ReDim Preserve Brr1(1 To r)Brr1(r) = iEnd IfIf Brr(i, 2) <> "" Thenr2 = r2 + 1ReDim Preserve Brr2(1 To r2)Brr2(r2) = iEnd IfNextFor i = 1 To rIf i <> r Thenjs = Brr1(i + 1) - 1Elsejs = UBound(Brr)End Ifks = Brr1(i)With Cells(ks, 1).Resize(js - ks + 1).MergeEnd WithNextFor i = 1 To r2If i <> r2 Thenjs = Brr2(i + 1) - 1Elsejs = UBound(Brr)End Ifks = Brr2(i)With Cells(ks, 2).Resize(js - ks + 1).MergeEnd WithNext[a1].CurrentRegion.Borders.LineStyle = 1 End Sub6，2级字典嵌套‘2013-2-6‘/thread-980784-1-1.htmlSub lqxs()Dim Arr, i&, j&Dim d, k, t, d1, k1, t1, n&Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet2.ActivateArr = [a1].CurrentRegionFor j = 2 To UBound(Arr, 2)For i = 2 To UBound(Arr)d(Arr(1, j)) = d(Arr(1, j)) + 1If d1.Exists(Arr(1, j)) = False Then Set d1(Arr(1, j)) = CreateObject("Scripting.Dictionary")d1(Arr(1, j))(Arr(i, j)) = d1(Arr(1, j))(Arr(i, j)) + 1NextNextk = d.keys: t = d.itemsn = 40For i = 0 To UBound(k)k1 = d1(k(i)).keyst1 = d1(k(i)).itemsn = n + 1Cells(n, 1) = k(i)n = n + 1Cells(n, 1).Resize(d1(k(i)).Count, 1) = Application.Transpose(k1)Cells(n, 2).Resize(d1(k(i)).Count, 1) = Application.Transpose(t1)n = n + d1(k(i)).CountCells(n, 1) = "合计": Cells(n, 2) = t(i)NextEnd Sub7，字典的项为数组‘2013-2-8‘/thread-981240-1-1.htmlSub 数据3()Dim arrDim iRow&, i&, wbzb$'读取总表源数据wbzb = "总表"ThisWorkbook.ActivateWith Worksheets(wbzb)If Len(.[a4]) = 0 Then Exit Sub'高级筛选,去除重复值.Range("a3").CurrentRegion.AdvancedFilter xlFilterInPlace, , , TrueiRow = .Range("c" & Rows.Count).End(xlUp).RowIf iRow <= 3 Then Exit Sub '最后一行数据行低于第3行位置就退出arr = .Range("a3:j" & iRow)End With'arr2数组存储数据Dim dic As Object, arr2(), k&, j&'数据列对应关系，arrZos源列号，arrMpos目标列号Dim arrZPos, arrMPos, arrTemparrZPos = Array(4, 5, 6, 7, 8, 9, 10)arrMPos = Array(1, 2, 3, 4, 5, 10, 11)'以支行网点名字存入字典Set dic = CreateObject("Scripting.dictionary")For i = 2 To UBound(arr)If Not dic.exists(arr(i, 3)) ThenReDim arr2(1 To 11, 1 To 1)For j = LBound(arrZPos) To UBound(arrZPos)arr2(arrMPos(j), 1) = arr(i, arrZPos(j))Nextdic(arr(i, 3)) = Array(1, arr2) ' dic(arr(i, 3))(0)为存入个数，dic(arr(i, 3))(1)为数组ElsearrTemp = dic(arr(i, 3))k = arrTemp(0) + 1arr2 = arrTemp(1)ReDim Preserve arr2(1 To 11, 1 To k)For j = LBound(arrZPos) To UBound(arrZPos)arr2(arrMPos(j), k) = arr(i, arrZPos(j))Nextdic(arr(i, 3)) = Array(k, arr2)End IfNextOn Error Resume NextDim wb As WorkbookDim wbname$, Slash$wbname = "明细.xls"Slash = Application.PathSeparatorDim secAutomation As MsoAutomationSecuritySet wb = Workbooks(wbname)If Err.Number <> 0 ThenErr.ClearMsgBox ThisWorkbook.Path & Slash & wb'防止打开时运行宏secAutomation = Application.AutomationSecurityApplication.AutomationSecurity = msoAutomationSecurityForceDisableSet wb = Workbooks.Open(ThisWorkbook.Path & Slash & wbname)If Err.Number <> 0 ThenMsgBox "打开" & wb & " 出错"Err.ClearExit SubEnd IfEnd Ifwb.ActivateDim arrKey, wbZong$, keyitem, endrow2&, endrow&For Each keyitem In dic.keysWith Worksheets(keyitem)If Err.Number = 0 Then.Range("d:e").NumberFormatLocal = "@".Range("f:f").NumberFormatLocal = "G/通用格式"endrow = .Range("c" & Rows.Count).End(xlUp).Row = 3If endrow > 3 Then.Range("a4:j" & endrow).ClearContents.Range("a4:j" & endrow).Borders.LineStyle = xlNoneEnd Ifendrow = 4arr2 = WorksheetFunction.Transpose(dic(keyitem)(1))If dic(keyitem)(0) > 1 Then ‘只有1项时，赋值语句不同.Range("a" & endrow).Resize(UBound(arr2), 11) = arr2endrow2 = .Range("c" & Rows.Count).End(xlUp).Row.Range("f" & endrow).FormulaR1C1 = "=IF(COUNTIF(R4C[5]:RC11,RC[-1]&""*"")=1,""√"","""")".Range("f" & endrow & ":f" & endrow2).FillDownElse.Range("a" & endrow).Resize(1, 11) = arr2.Range("f4").FormulaR1C1 ="=IF(COUNTIF(R4C[5]:RC11,RC[-1]&""*"")=1,""√"","""")"End IfEnd IfErr.ClearEnd WithNextApplication.AutomationSecurity = msoAutomationSecurityByUIEnd Sub8，2级字典嵌套（数据有效性）‘2013-2-23‘/thread-985283-1-1.htmlPrivate Sub Worksheet_Change(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf Target.Address <> "$K$2" And Target.Address <> "$M$2" Then Exit Sub Dim Arr, i&, x$, d, Brr, c%Set d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionBrr = [a4].Resize(UBound(Arr) - 3, UBound(Arr, 2))For i = 5 To UBound(Arr, 2)x = Arr(1, i) & "|" & Arr(2, i)d(x) = iNextx = [k2].Value & "|" & [m2].Value[m4].Resize(UBound(Brr), 1).ClearContentsIf d.exists(x) Thenc = d(x)[m4].Resize(UBound(Brr), 1) = Application.Index(Brr, 0, c)End IfEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf Target.Address <> "$K$2" And Target.Address <> "$M$2" Then Exit Sub Dim Arr, i&, x$, d, Brr, c%Set d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionFor i = 5 To UBound(Arr, 2)x = Arr(1, i): y = Arr(2, i)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) + 1Nextk = d.keysIf Target.Address = "$K$2" ThenWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(d.keys, ",")End WithTarget.Offset(0, 2) = ""Elset = d(Target.Offset(0, -2).Value).keysWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(t, ",")End WithEnd IfEnd Sub9，列表框4级数据有效性、多条件查询‘2013-3-3‘/thread-987829-1-1.htmlDim d As New Dictionary, Arr, Brr, k, tDim d1 As New DictionaryDim d2 As New DictionaryDim d3 As New DictionaryPrivate Sub ComboBox1_Change()ComboBox2.Clear: ComboBox2 = ""ComboBox3.Clear: ComboBox3 = ""ComboBox4.Clear: ComboBox4 = ""boBox2.List = d1(boBox1.Value).itemsEnd SubPrivate Sub ComboBox2_Change()If ComboBox2 = "" Then Exit SubComboBox3.ClearComboBox4.ClearboBox3.List = d2(boBox1.Value & boBox2.Value).items End SubPrivate Sub ComboBox3_Change()If ComboBox3 = "" Then Exit SubComboBox4.ClearboBox4.List = d3(boBox1.Value & boBox2.Value & boBox3.Value).itemsEnd SubPrivate Sub CommandButton1_Click()Dim i&, x$, y$, j&, aa[b7:g5000].ClearContentsArr = Sheet1.[a1].CurrentRegionIf boBox4 <> "" Thenx = boBox1.Text & boBox2.Text & boBox3.Text & boBox4.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6) & Arr(i, 7) & Arr(i, 8)If x = y ThenIf Arr(i, 2) <> "" Then d(Arr(i, 2)) = d(Arr(i, 2)) & i & ","End IfNextCall yyy(2)[b6] = "销售人员"ElseIf boBox3 <> "" Thenx = boBox1.Text & boBox2.Text & boBox3.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6) & Arr(i, 7)If x = y ThenIf Arr(i, 8) <> "" Then d(Arr(i, 8)) = d(Arr(i, 8)) & i & ","End IfNextCall yyy(8)[b6] = "小组"ElseIf boBox2 <> "" Thenx = boBox1.Text & boBox2.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6)If x = y ThenIf Arr(i, 7) <> "" Then d(Arr(i, 7)) = d(Arr(i, 7)) & i & ","End IfNextCall yyy(7)[b6] = "区域"Elsex = boBox1.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1))If x = y ThenIf Arr(i, 6) <> "" Then d(Arr(i, 6)) = d(Arr(i, 6)) & i & ","End IfNextCall yyy(6)[b6] = "城市"End If[b7].Resize(UBound(Brr), 6) = Brrm = [b65536].End(xlUp).Row[f7].Formula = "=rc[-2]/rc[-3]"[g7].Formula = "=rc[-2]/rc[-4]"If m > 7 Then[f7:g7].AutoFill [f7:g7].Resize(m - 6, 2)End Ifd.RemoveAll: Erase BrrEnd SubSub yyy(c)k = d.keyst = d.itemsReDim Brr(1 To d.Count, 1 To 6)For i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)If InStr(t(i), ",") Thenaa = Split(t(i), ",")For j = 0 To UBound(aa)Brr(i + 1, 1) = Arr(aa(j), c)Brr(i + 1, 2) = Brr(i + 1, 2) + Arr(aa(j), 3)Brr(i + 1, 3) = Brr(i + 1, 3) + Arr(aa(j), 9)Brr(i + 1, 4) = Brr(i + 1, 4) + Arr(aa(j), 10)NextElseBrr(i + 1, 1) = Arr(t(i), c)Brr(i + 1, 2) = Brr(i + 1, 2) + Arr(t(i), 3)Brr(i + 1, 3) = Brr(i + 1, 3) + Arr(t(i), 9)Brr(i + 1, 4) = Brr(i + 1, 4) + Arr(t(i), 10)End IfNextEnd SubPrivate Sub Worksheet_Activate()Dim i&, xx, yy, zz, aa, bb, cp, fl, xhOn Error Resume NextArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)xx = Arr(i, 1) & ""yy = Arr(i, 6)zz = Arr(i, 7)aa = Arr(i, 8)cp = Arr(i, 1) & Arr(i, 6)fl = Arr(i, 1) & Arr(i, 6) & Arr(i, 7)If d1.Exists(xx) = False Then Set d1(xx) = New DictionaryIf yy <> "" Then d1(xx)(yy) = yyIf d2.Exists(cp) = False Then Set d2(cp) = New DictionaryIf zz <> "" Then d2(cp)(zz) = zzIf d3.Exists(fl) = False Then Set d3(fl) = New DictionaryIf aa <> "" Then d3(fl)(aa) = aaNextboBox1.List = d1.keysEnd Sub10，3级字典嵌套‘2013-3-8‘/forum.php?mod=viewthread&tid=989716&page=1&extra=#pid676777 9Sub lqxs()Dim Arr2, Arr3, Arr4, i&, x$, y$, j&, aa, bb, cp$Dim d, k, t, k1, t1, k2, t2, k3, t3, kk, tt, jj&, s&Dim Arr33, Arr5Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[a2:l10].ClearContentsArr2 = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr2)d(Arr2(i, 1)) = d(Arr2(i, 1)) & i & ","Nextk = d.keyst = d.items: d.RemoveAllArr3 = Sheet3.[a1].CurrentRegionArr33 = Sheet3.[b1].Resize(UBound(Arr3), UBound(Arr3, 2))For i = 2 To UBound(Arr3)x = Arr3(i, 1): y = Arr3(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) & i & ","Nextk1 = d.keyst1 = d.itemsArr4 = Sheet4.[a1].CurrentRegionArr5 = Sheet4.[b1].Resize(UBound(Arr4), UBound(Arr4, 2))For i = 2 To UBound(Arr4)x = Left(Arr4(i, 1), 1): y = Arr4(i, 1)cp = x & "," & yIf d1.exists(cp) = False Then Set d1(cp) = CreateObject("Scripting.Dictionary")d1(cp)(y) = d1(cp)(y) & i & ","Nextk2 = d1.keyst2 = d1.items: n = 2For i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)Cells(n, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, t(i), 0)If d.exists(k(i)) Thenkk = t1(i).keys: tt = t1(i).itemsFor j = 0 To UBound(kk)cp = k(i) & "," & kk(j)tt(j) = Left(tt(j), Len(tt(j)) - 1)Cells(n, 5).Resize(1, UBound(Arr33, 2)) = Application.Index(Arr33, tt(j), 0)If d1.exists(cp) Thenk3 = t2(j).keyst3 = t2(j).itemsFor jj = 0 To UBound(k3)t3(jj) = Left(t3(jj), Len(t3(jj)) - 1)If InStr(t3(jj), ",") Thenbb = Split(t3(jj), ",")For s = 0 To UBound(bb)Cells(n, 9).Resize(1, UBound(Arr5, 2)) = Application.Index(Arr5, bb(s), 0)n = n + 1NextElseCells(n, 9).Resize(1, UBound(Arr5, 2)) = Application.Index(Arr5, t3(jj), 0)n = n + 1End IfNextElsen = n + 1End IfNextNextEnd Sub11，2级字典嵌套汇总‘2013-3-9‘/thread-990101-1-1.htmlSub lqxs()Dim Arr, i&, x$, y$Dim d, k, d1Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet3.ActivateArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 5): y = Arr(i, 1)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) + Arr(i, 8)Nextk = d.keysArr2 = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr2)x = Arr2(i, 2): y = Left(Arr2(i, 1), 7)If d1.exists(x) = False Then Set d1(x) = CreateObject("Scripting.Dictionary")d1(x)(y) = d1(x)(y) + Arr2(i, 3)Next[a2].Resize(d.Count) = Application.Transpose(k)For i = 0 To UBound(k)Cells(i + 2, 2) = d(k(i))(CStr([b1].Value))Cells(i + 2, 3) = d(k(i))(CStr([c1].Value))Cells(i + 2, 4) = Cells(i + 2, 2) + Cells(i + 2, 3) - d1(k(i))(CStr([b1].Value)) - d1(k(i))(CStr([c1].Value))NextEnd Sub12，2级字典嵌套（数据有效性）‘/thread-922132-1-1.htmlPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf (Target.Column <> 4 And Target.Column <> 6) Or Target.Row < 2 Then Exit Sub Dim t, Arr, dDim i&, x$, Brr, y$Set d = CreateObject("Scripting.Dictionary")Arr = Sheet10.[f1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = yNextIf Target.Column = 4 ThenWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(d.keys, ",")End WithTarget.Offset(0, 2) = ""Elsex = Target.Offset(0, -2).ValueIf d.exists(x) Thent = d(x).keysWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=IIf(UBound(t) <> -1, Join(t, ","), t) End WithElseTarget = ""End IfEnd IfEnd Sub13，2级字典嵌套（成绩提取）‘2013-3-24‘/thread-995893-1-1.htmlSub lqxs()Dim Arr, i&, Arr1, x$, y$, funm$, myPath$, myName$, BrrDim d, k, t, wb As Workbook, a, b, aa, j&, zh, ps, txt$, mx1, mx2Application.ScreenUpdating = FalseSet d = CreateObject("Scripting.Dictionary")Sheet1.ActivateArr1 = [a1].CurrentRegion[a1].CurrentRegion.ClearCommentsSet wb = ThisWorkbookfunm = myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xlsx")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Arr = .Sheets(1).Range("a1").CurrentRegion.Close FalseFor i = 1 To UBound(Arr, 2)If Arr(1, i) = "学号" Then c1 = iIf Arr(1, i) = "课程名称" Then c2 = i: Exit ForNextFor i = 2 To UBound(Arr)x = Arr(i, c1): y = Arr(i, c2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) & Arr(i, c2 + 1) & "," & Arr(i, c2 + 2) & "|"NextEnd WithmyName = DirLoopk = d.keys: t = d.itemsFor i = 9 To UBound(Arr1) - 1x = Arr1(i, 2)If d.exists(x) ThenFor j = 6 To UBound(Arr1, 2) Step 2y = Arr1(7, j)If d(x).exists(y) Thena = d(x)(y)a = Left(a, Len(a) - 1)If InStr(a, "|") Thenaa = Split(a, "|")mx1 = 0: mx2 = 0: txt = ""For ii = 0 To UBound(aa)txt = txt & ii + 1 & "," & aa(ii) & vbCrLfb = Split(aa(ii), ",")zh = Val(b(0)): ps = V al(b(1))If zh > mx1 Then mx1 = zhIf ps > mx2 Then mx2 = psNextCells(i, j).AddComment Text:=txtArr1(i, j) = mx1: Arr1(i, j + 1) = mx2Elseaa = Split(a, ",")Arr1(i, j) = aa(0): Arr1(i, j + 1) = aa(1)End IfEnd IfNextEnd IfNextColumns("b:b").NumberFormatLocal = "@"[a1].CurrentRegion = Arr1Application.ScreenUpdating = TrueEnd Sub14，多条件查询‘2013-5-19‘/thread-1018683-1-1.htmlSub lqxs()Dim Arr, i&, d, k, t, d1, Brr, j&, Arr1Dim x$, y, z$, a$, b$, c$Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[b5:p6].ClearContents[b5:p6].Borders.LineStyle = xlNoneArr1 = [a1].CurrentRegionArr = Sheet2.[a1].CurrentRegionFor i = 3 To UBound(Arr, 2)d1(Arr(2, i)) = iNextk1 = d1.keys[b5].Resize(1, d1.Count) = k1[b5].Resize(2, d1.Count).Borders.LineStyle = 1ReDim Brr(1 To d1.Count)For j = 3 To UBound(Arr, 2)For i = 3 To UBound(Arr)x = Arr(i, 1): z = Arr(i, 2): y = Arr(2, j)a = x & "|" & z:b = x & "|" & y:c = z & "|" & yIf d.exists(a) = False Then Set d(a) = CreateObject("Scripting.Dictionary")d(a)(y) = d(a)(y) + Arr(i, j)d(b) = d(b) + Arr(i, j)d(c) = d(c) + Arr(i, j)NextNextk = d.keys: t = d.itemsFor j = 2 To UBound(Arr1, 2)If Arr1(1, j) <> "" ThenIf Arr1(2, j) <> "" Thena = Arr1(1, j) & "|" & Arr1(2, j)For i = 0 To UBound(k1)tt = d(a)(k1(i))Brr(i + 1) = Brr(i + 1) + d(a)(k1(i))NextElseFor i = 0 To UBound(k1)b = Arr1(1, j) & "|" & k1(i)Brr(i + 1) = Brr(i + 1) + d(b)NextEnd IfElseIf Arr1(2, j) <> "" ThenFor i = 0 To UBound(k1)c = Arr1(2, j) & "|" & k1(i)Brr(i + 1) = Brr(i + 1) + d(c)NextEnd IfEnd IfNext[b6].Resize(1, d1.Count) = BrrEnd Sub15，2级字典嵌套（分表）‘/thread-1026658-1-1.html‘Split Data0613.xlsmSub lqxs()Dim Arr, i&, x$, y$, Sht As WorksheetDim d, k, t, k1, t1, Myr&, rng As RangeSet d = CreateObject("Scripting.Dictionary")Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseFor Each Sht In SheetsIf <> "Data" And <> "模板" Then Sht.Delete NextSheet1.ActivateArr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 2): y = Trim(Arr(i, 3))If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) + 1Nextk = d.keys: t = d.itemsFor i = 0 To UBound(k)Sheets("模板").Copy after:=Sheets(Sheets.Count)Set Sht = ActiveSheetWith Sht.Name = k(i)k1 = t(i).keyst1 = t(i).itemsSet rng = .[a31:d38].[a31] = k1(0).[d32] = t1(0)For j = 1 To UBound(k1)Myr = .[c65536].End(xlUp).Row + 1rng.Copy .Cells(Myr, 1).Cells(Myr, 1) = k1(j).Cells(Myr + 1, 4) = t1(j)NextEnd WithNextApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub16，中国式排名（D列）‘/thread-1103691-1-1.htmlSub lqxs()Dim Arr, i&, x, y$, j&, aa, Brr, Crr, cDim d, k, t, d1, k1, t1, kk, ttSet d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[d2:e5000].ClearContentsArr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) & i & ","Nextk = d.keys: t = d.itemsFor i = 0 To UBound(k)kk = t(i).keys: tt = t(i).itemsFor ii = 0 To UBound(kk)tt(ii) = Left(tt(ii), Len(tt(ii)) - 1): n = 0: n1 = 0If InStr(tt(ii), ",") Thenaa = Split(tt(ii), ",")ReDim Brr(UBound(aa))ReDim Crr(UBound(aa))For j = 0 To UBound(aa)Brr(j) = Arr(aa(j), 3)NextFor j = 0 To UBound(Brr)d1(Brr(j)) = d1(Brr(j)) & aa(j) & ","Nextk1 = d1.keys: t1 = d1.itemsd1.RemoveAllFor j = 0 To UBound(k1)t1(j) = Left(t1(j), Len(t1(j)) - 1)If InStr(t1(j), ",") Thena = Split(t1(j), ",")n = n + 1: n1 = n1 + 1For jj = 0 To UBound(a)Arr(a(jj), 4) = nArr(a(jj), 5) = n1Nextn1 = n1 + UBound(a)Elsen = n + 1Arr(t1(j), 4) = nn1 = n1 + 1Arr(t1(j), 5) = n1End IfNextElseArr(tt(ii), 4) = 1Arr(tt(ii), 5) = 1End IfNextNext[a1].CurrentRegion = ArrEnd Sub17，多级字典嵌套by:lee1892'===============================================' 字典实现的多级单元格下拉示例' By Lee1892 @ ExcelHome 2011.05.06'-----------------------------------------------' 此示例中：' Sheet1 为需要实现级联的表单' Sheet2 为存放级联内容的表单' 涉及到的事件包括：' Workbook 的Open 事件' Sheet1 的Change 事件' Sheet2 的Change 事件'-----------------------------------------------' 可以实现的功能：' 1 根据级联内容表单的内容自动生成动态级联下拉单，' 没有级联层数的限制' 2 可以随时更新级联内容，包括级联的层数和内容。

常见字典用法集锦及代码详解常见字典用法集锦及代码详解2 蓝桥玄霜前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。

有了它们，我们可以。

很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。

凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。

我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。

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

深受大家的喜爱。

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

给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。

所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。

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

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

字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。

就好像一本字典书一样，是由很多生字和对它们对应的注解所组-可编辑修改-常见字典用法集锦及代码详解成。

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

常用关键字英汉对照：Dictionary 字典Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。