常见字典用法集锦及代码详解(全)-蓝桥玄霜

常见字典用法集锦及代码详解 蓝桥玄霜 常见字典用法集锦及代码详解 2 前言 凡是上过学校的人都使用过字典 从新华字典 成语词典 到英汉字典以及各种各 样数不胜数的专业字典 字典是上学必备的 经常查阅的工具书 有了它们 我们可以 很方便的通过查找某个关键字 进而查到这个关键字的种种解释 非常快捷实用 凡是上过 EH 论坛的想学习 VBA 里面字典用法的 几乎都看过研究过 northwolves狼版主 oobird 版主的有关字典的精华贴和经典代码 我也是从这里接触 到和学习到字典的 在此 对他们表示深深的谢意 同时也对很多把字典用得出神入化 的高手们致敬 从他们那里我们也学到了很多 也得到了提高 字典对象只有 4 个属性和 6 个方法 相对其它的对象要简洁得多 而且容易理解使 用方便 功能强大 运行速度非常快 效率极高 深受大家的喜爱 本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想 要进一步了解字典用法的朋友提供一点备查的参考资料 希望大家能喜欢 给代码注释估计是大家都怕做的 因为往往是出力不讨好的 稍不留神或者自己确 实理解得不对 还会贻误他人 所以下面的这些注释如果有不对或者不妥当的地方 请 大家跟帖时指正批评 及时改正 字典的简介 字典 Dictionary 对象是微软 Windows 脚本语言中的一个很有用的对象 附带提一下 有名的正则表达式 RegExp 对象和能方便处理驱动器 文件夹和文件 的 FileSystemObject 对象也是微软 Windows 脚本语言中的一份子 字典对象相当于一种联合数组 它是由具有唯一性的关键字 Key 和它的项 Item 联合组成 就好像一本字典书一样 是由很多生字和对它们对应的注解所组成 比如字典的 典 字的解释是这样的 典 字就是具有唯一性的关键字 后面的解释就是它的项 和 典 字联合组成一对 数据 常用关键字英汉对照 Dictionary字典字典 字典的简介 3 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 常见字典用法集锦及代码详解 4 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 字典的简介 5 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 得到的也是一个一维 常见字典用法集锦及代码详解 6 数组 下限为 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 字典的简介 7 代码详解代码详解 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 常见字典用法集锦及代码详解 8 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 函数精选合集 实例 1 普通常见的求不重复值问题 9 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 普通常见的求不重复值问题 一 问题的提出问题的提出 表格中人员有很多是重复的 要求编写一段代码 把重复的人员姓名以及重复的次 数求出来 复制到另一个表格中 如图实例 1 1 所示 常见字典用法集锦及代码详解 10 论坛网址 图 实例 1 1 二 代码二 代码 Sub cfz Dim i 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 把多个条件比例 位置 项 常见字典用法集锦及代码详解 26 目名称 大系统编号 小系统编号和相同楼层数用连接符号 连成一个字符串 然 后赋给变量 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 函数精选合集 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 所示 实例 7 字典法排序 27 图 实例 6 1 示例 实例 7 字典法排序 一 问题的提出问题的提出 A 列 B 列是按顺序排列的全部股票代码和股票名称 C 列 D 列和 E 列 F 列是另外 按条件筛选出来的无序的数据 要求编写一段代码 将它们排列到与 A 列相同的股票 行里面 代码执行前如图实例 7 1 所示 常见字典用法集锦及代码详解 28 图 实例 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 实例 7 字典法排序 29 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 所示 常见字典用法集锦及代码详解 30 图 实例 7 2 示例 实例 8 2 级动态数据有效性问题 一 问题的提出问题的提出 A 列是源名称 中间有空格 B 列为各个源名称对应的数目不同的代号 C 列是目 标名称来源于源名称 要求在 C 列设置不重复的 没有空格的数据有效性供选择 同时 D 列目标代号 要求随着 C 列选择的目标名称的不同 提供对应的代号供选择 是为第 2 级数据有效性 代码执行前如图实例 8 1 所示 实例 8 2 级动态数据有效性问题 31 图 实例 8 1 示例 二 代码二 代码 Private Sub Worksheet SelectionChange ByVal Target As Range If Target Count 1 Then Exit Sub If Target Column 4 And Target Column 3 Then Exit Sub Dim d i Myr Arr r Arr1 cp ks js j Set 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 d Arr i 1 End If Next With Target Validation Delete 常见字典用法集锦及代码详解 32 Add Type xlValidateList AlertStyle xlValidAlertStop Operator xlBetween Formula1 Join d keys End With Target Offset 0 1 ElseIf Target Column 4 And Target Offset 0 1 Then For i 1 To UBound Arr If Arr i 1 Then r r 1 ReDim Preserve Arr1 1 To r Arr1 r i End If Next i For i 1 To r If Arr Arr1 i 1 Target Offset 0 1 Text Then If i r Then js Arr1 i 1 1 Else js Myr 1 End If ks Arr1 i For j ks To js cp cp Arr 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 实例 8 2 级动态数据有效性问题 33 End If Set d Nothing End Sub 三 代码详解三 代码详解 1 Private Sub Worksheet SelectionChange ByVal Target As Range 本例用的是工 作表选择变化事件 只要鼠标点击单元格都会激活这个事件 Private 可译为私有的 限 制了这段代码只能在指定的工作表里有效 参数 Target 声明为单元格区域对象 有了关 键字 ByVal 说明可以按值传递参数 2 If Target Count 1 Then Exit Sub 由于是鼠标点击单元格都会激活这个事件 所 以最好要作一些限制 使得你能避免点击了不需要激活事件的地方而激活本事件产 生错误 本句是如果目标单元格的数目大于 1 就退出本过程 这样当你点选了多个 单元格的时候 过程运行了这句代码就会结束过程了 3 If Target Column 4 And Target 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 在数组 Arr 之间逐一循环 如果 A 列数组的值不等于空 就作为关键字加入字典 d 这样就排除了空值进入字典 7 With Target Validation 这里使用了 With 语句 With 语句为我们提供了十分 简便的对象引用手段 使用它有 3 个优点 可以减少代码的输入量 增加代码的可 读性 改善代码的执行效率 在 End With 之前的语句都是对目标单元格的有效性 对象的各个属性进行设置 8 Delete 先删除该单元格的数据有效性 注意 Delete 前有个小圆点 在小圆 点之前就省略了 Target Validation 即减少了代码的输入量 这个小圆点不能遗漏 否则会出错 9 Add Type xlValidateList AlertStyle xlValidAlertStop Operator xlBetween Formula1 Join d keys Add 是有效性对象的方法 向指 定区域内添加数据有效性检验 参数 Type 是数据有效性类型 当类型等于 xlValidateList 时 后面的公式 1 参数 Formula1 必须包含以逗号分隔的取值列表 参数 AlertStyle 是出错警告样式 这里是停止样式 参数 Operator 是数据有效性运 算符 有大于 小于 大于或等于 小于或等于 介于 不介于 等于 不等于等 等 这里取介于 公式 1 参数 Formula1 的值用了 VBA 函数 Join 把字典的关键字 用逗号分隔后连接起来赋给公式 1 参数 这样 目标单元格那的数据有效性中就没 常见字典用法集锦及代码详解 34 有重复值了 10 Target Offset 0 1 给目标单元格设置了数据有效性以后 把它同行 D 列 单元格的值清除 这是为了确保 D 列的值只与 C 列的目标名称相对应 11 ElseIf Target Column 4 And Target Offset 0 1 Then 否则如果目标单元 格是 D 列的 并且同行 C 列单元格不是空的情况下 执行这下面的代码 Offset 属 性的详解可见前面实例 6 的第 2 条解释 12 For i 1 To UBound Arr 在数组 Arr 之间逐一循环 13 If Arr i 1 Then 如果 A 列数组的值不等于空 就执行下面的代码 14 r r 1 变量 r 累加 15 ReDim Preserve Arr1 1 To r 重新声明动态数组的大小 Preserve 是关键字 当改变原有数组最末维的大小时 使用此关键字可以保持数组中原来的数据 这句 是改变动态数组大小的最常用语句 不能忘记 Preserve 关键字 16 Arr1 r i 把关键字在数组 Arr 中行的位置赋给新的动态数组 Arr1 r 这个 循环可求得 A 列每一个源名称所在的行的位置 17 For i 1 To r 上面的循环求得了一共有 r 个源名称 逐一循环 18 If Arr Arr1 i 1 Target Offset 0 1 Text Then 如果 C 列的目标名称等于源名 称时执行下面的代码 19 If i r Then 如果 i 不等于 r 时执行下面的代码 20 js Arr1 i 1 1 把下一个源名称所在的行数 1 以后赋给变量 js 这样来求 得每一个源名称的开始和结束的位置 21 js Myr 1 否则就是最后一行 1 的只赋给变量 js 最后一个源名称在数 组中的位置 22 ks Arr1 i 把数组的值赋给变量 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 得到的是一个以 0 为下 界的一维函数 所以它的第一个元素就用 0 来表示 代码执行后如图实例 8 2 所示 实例 9 字典取行数 数组重新赋值 35 图 实例 8 2 示例 实例 9 字典取行数 数组重新赋值 一 问题的提出问题的提出 要求编写一段代码 求得 B 列不重复的名字 其相应的 A 列和 D 列分别用 连起 来 而相应的 E 列 F 列的数值分别相加汇总 代码执行前如图实例 9 1 所示 常见字典用法集锦及代码详解 36 图 实例 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 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 1 d R i 2 i 实例 9 字典取行数 数组重新赋值 37 For j 1 To UBound R 2 R k j R i j Next End If Next With Sheet2 Cells ClearContents Cells Borders LineStyle 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 变量 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 方法进行判断 如果字典中存在 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 行数据 而第 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 列的数据用 连起来再赋给 常见字典用法集锦及代码详解 38 A 列这个数组元素 12 R d R i 2 4 R d R i 2 4 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 Cells Borders LineStyle xlNone 清除表 2 所有的边框 Borders 是 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 先字典求得行后显示整行数据 39 实例 10 先字典求得行后显示整行数据 一 问题的提出问题的提出 有 3 列数据 要求编写一段代码 如果 C 列名次 A 列主排相同时 根据 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 Activate Myr a65536 End xlUp Row 常见字典用法集锦及代码详解 40 Range A1 C Myr Sort Key1 Range C2 Order1 xlAscending Key2 Range 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 exists 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 Order3 xlDescending Header xlYes 对 ABC 三列进行排序 主要关键字 Key1 名次 升序 次要关键字 Key2 主排 升序 第 3 关键字 Key3 次排 降序 3 Arr Range a2 c Myr 把 ABC 列数据赋给变量 Arr 4 For i 1 To UBound Arr i 从 1 到数组 Arr 的最大上界逐一循环 5 x Arr i 1 Arr i 3 把主排和 和名次连起来赋给变量 x 6 If Not d exists x Then 如果字典中不存在 x 这个关键字 那么执行下面的代码 7 d Add x i 1 把 x 作为关键字和这个关键字的具体的行作为对应的项加入字 典 因为数组 Arr 是从 A2 开始的 所以 i 与数据的实际行相差 1 i 1 就是数据的 实际行 8 e g ClearContents 清空 E G 列 9 e2 Resize d Count 1 Application Transpose d items 把字典所有的项转置 实例 10 先字典求得行后显示整行数据 41 以后赋给 E2 单元格开始的区域 10 For Each rng In e2 Resize d Count 1 For Each Next 控制结构是 VBA 中功 能最强的循环控制结构 利用这个结构可对集合中的所有对象或者数组中的所有元 素进行同一操作 它的一个优点在于你不必操心循环应该执行多少次 它循环的次 数恰好就是数组中元素的个数 或者集合中对象的个数 因此对于处理多维数组 特别是处理对象时最有效率 本句意思是在 E2 单元格开始的单元格区域中逐一循 环 11 rng Resize 1 3 Cells rng 1 Resize 1 3 Value 把关键字所在行的 3 个单元 格的值赋给 rng 开始的 3 个单元格 在 Cells rng 1 中作为参数的 rng rng Valur 而 rng Resize 1 3 处的 rng 是一个单元格对象 代码执行后如图实例 10 2 所示 图 实例 10 2 示例 常见字典用法集锦及代码详解 42 实例 11 关键字赋给两列后用 Replace 方法 一 问题的提出问题的提出 有如图实例 11 1 所示的工资表 要求编写一段代码 运用 VBA 自动生成 1 季度的 工资表 解题思路 先把性别和姓名连起来作为关键字求得人员的不重复值 然后通过循环 查找关键字获得其各月的工资 最后用 Replace 方法替换两列关键字区域得到各自 的数据 代码执行前如图实例 11 1 所示 图 实例 11 1 示例 实例 11 关键字赋给两列后用 Replace 方法 43 二 代码二 代码 Sub yy Dim d k t i j Arr x r1 Set d CreateObject Scripting Dictionary Arr a1 CurrentRegion For i 1 To UBound Arr 2 Step 3 For j 2 To UBound Arr If Arr j i Then x Arr j i Arr j i 1 d x End If Next Next k d keys a12 i1000 ClearContents a13 Resize d Count 2 Application Transpose k a12 b12 Array 性别 姓名 For i 3 To UBound Arr 2 Step 3 Cells 12 2 i 3 Cells 1 i Next Fo