创建文章目录词典对象词典的属性|方法案例计数的重新统计匹配key的组合和分割词典value多字段词典的统计和计数同时进行的类似sql的连接操作
创建词典对象“后绑定”使代码更容易在其他计算机上运行，建议使用。 dimdicasobjectsetdic=createobject ' scripting.dictionary ' '前期绑定：可以直接声明词典对象，提供对象属性和方法提示，但未检查引用引用检查：在VBE表单-工具-引用-检查' microsoftscriptingruntime ' dimdicasnewdictionary '字段中输入键值对key-value=key='名称' value ems密钥值对数量： dic.count密钥： DIC.exists (key )清除词典密钥值对： dic.removeall确定删除密钥是否为密钥的密钥值对： DIC.remove密钥. cellss (1，1 ).resize(DIC.count，1 )=application.worksheet function.transpose (DIC.keys ) '工作表中的单元格内容. cell dic.count )=dic.items )确定某个内容是否为词典密钥中的if dic.exists (内容) then debug.print字符串“内容” key是需要删除词典的密钥dic.remove keyend with的情况dimdicasobjectdimarrdimstsetdic=createobject (scripting.dictionary ' ) arr=array 即使引入重复词典也只存在一个。 你可以利用词典的这个特性来加重。 '这里不需要词典的值。 也可以设定为空字符串或其他数值。 DIC(ST )='nextactivesheet.range ) ' a1 ' ).resize ) DIC.count， 1 )=application.worksheet function.transpose (d.keys )和Sub dic_sumif )合计application.screen updating=falsedimdiong ct'scripting.dictionary ' ) withactivesheetarr=.usedrangefori=2to ubound (arr ) ' DIC(ARR(I ) I，1 ) () ) ) ) ) 1 )=DIC ) ARR ) I，1 ) ) ARR ) I，2 )使用Next ) copy方法将标题复制到e1，f1单元格. range(a1:B1).copy.range 1 )=application.worksheet function.transpose (DIC.keys ) For i=2 To dic.Count 1)循环输入词典' f ' ).Value2=DIC(.cells
效果如下图所示。
统计上述水果种类后，countifs只需将分类汇总的值变更为数值1即可，每当出现‘1’时
将它添加到DIC(ARR(I，1 )=DIC (arr ) I，1 ) ) 1上的代码中，下图显示了下标题中range('F1 ' ).value2='计数'的效果。
匹配这个的应该是用词典最多的。 必须注意的是，使用单元格写入词典时，单元格还包含格式等信息。 如果只需要单元格值，请使用单元格. value2方法。 另外，词典的值也可以是数组。 数据源：
目标：与“李白”和“后羿”匹配的身高和体重编码如下： Sub data_matc
h()Application.ScreenUpdating = FalseDim dic As ObjectDim arrDim i As ByteSet dic = CreateObject("scripting.dictionary")With ActiveSheet arr = .Cells(1, 1).CurrentRegion For i = 2 To UBound(arr) '这里字典的值，用的是array数组，方便我们一下匹配多个数据，省去再创建字典对象麻烦。 dic(arr(i, 1)) = Array(arr(i, 2), arr(i, 3)) Next For i = 2 To .Cells(1, "e").End(xlDown).row .Cells(i, "f").Resize(1, 2) = dic(.Cells(i, "e").Value2) NextEnd Withset dic = NothingApplication.ScreenUpdating = TrueEnd Sub效果如下：
我在这里加入了‘妲己’，遍历用字典去匹配了，但是字典并没有‘妲己’这个key，匹配出来是空，并没有报错，大家不用担心字典没有对应key匹配而出错这种情况，这样只会将结果输出为空。~
如果需要匹配的姓名后面有之前填写的身高和体重信息，但是载入字典的数据源并没有这个人的信息，我们在遍历匹配时，又不想使身高和体重被替换为空，这时候可以结合dic.exisst语句，判断姓名是否存在于字典的keys中，再输出匹配结果。
字典的value可以数值，字符串，数组等对象；
Array可以通过索引获取对应的值，第一个数值的索引是0；Array(1,2,3,5)(0)返回的是1
key的组合和分割解决多字段匹配问题
dim arrdim i,row as longdim d as objectdim keyset d = createobject("scripting.dictionary")with thisworkbookarr = .sheets(1).usedrangefor i = 2 to ubound(arr)d(join(array(arr(i,1),arr(i,2),arr(i,3)),"|")) = arr(i,4)next' 把字典键值对写入到工作表with .sheets("输出")row = 2for each key in d.keys.cells(row,4).value = d(key).cells(row,1).resize(1,3) = split(key,"|")row = row + 1nextend withend withjoin方法可以将数组元素按照分隔符拼接起来，返回一个字符串；
split方法，是join的反函数，将一个字符串按照分隔符分割，返回一个数组；
比如分别加总活跃、付费等指标
Sub game_type_active_pay()Dim file_directory, f As StringDim i, last_row As LongDim d As ObjectDim wb As WorkbookDim arrDim active_uv, pay_uv As LongDim pay As DoubleApplication.ScreenUpdating = False ' 关闭屏幕刷新file_directory = ThisWorkbook.Path & "/data/"f = Dir(file_directory & "*细分品类*")'未找到数据源，提示，关闭应用If f = "" Then MsgBox "未找到命名包含‘细分品类’文字数据源，请先下载数据源......" Application.ScreenUpdating = True End ' 结束程序End IfSet wb = Workbooks.Open(file_directory & f) ' 打开工作簿Set d = CreateObject("scripting.dictionary") ' 创建字典对象arr = ActiveSheet.UsedRange'On Error Resume NextFor i = 2 To UBound(arr) If InStr("回流用户|留存用户|新增用户", arr(i, 4)) > 0 Then If arr(i, 3) = "类型1" Then arr(i, 3) = "类型2"'将类型1合并为类型2 If d.exists(arr(i, 1) & "|" & arr(i, 3)) Then ' vba没法直接对数组运算，将value拆开相加 active_uv = d(arr(i, 1) & "|" & arr(i, 3))(0) pay_uv = d(arr(i, 1) & "|" & arr(i, 3))(1) pay = d(arr(i, 1) & "|" & arr(i, 3))(2) ' 字段累加 active_uv = active_uv + arr(i, 6) '活跃累加 pay_uv = pay_uv + arr(i, 7) ' 付费uv累加 pay = pay + arr(i, 8) ' 付费累加 d(arr(i, 1) & "|" & arr(i, 3)) = Array(active_uv, pay_uv, pay) Else ' 如果不存在，直接生成一条记录 d(arr(i, 1) & "|" & arr(i, 3)) = Array(arr(i, 6), arr(i, 7), arr(i, 8)) End If End IfNext'On Error GoTo 0wb.Close False ' 关闭工作簿，不保存Set wb = NothingWith ThisWorkbook.Sheets("表名") arr = .UsedRange For i = 2 To UBound(arr) If d.exists(arr(i, 1) & "|" & arr(i, 2)) Then '如果新的数据源里存在该条记录，则用新的数据源覆盖 .Cells(i, 3).Resize(1, 3) = d(arr(i, 1) & "|" & arr(i, 2)) .Cells(i, 6).Value2 = .Cells(i, 5).Value2 / .Cells(i, 3).Value2 d.Remove arr(i, 1) & "|" & arr(i, 2) End If Next last_row = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '将新的记录写入到数据源 For Each Key In d.keys .Cells(last_row, 1).Resize(1, 2) = Split(Key, "|") .Cells(last_row, 3).Resize(1, 3) = d(Key) .Cells(last_row, 6).Value2 = .Cells(i, 5).Value2 / .Cells(i, 3).Value2 last_row = last_row + 1 NextEnd WithApplication.ScreenUpdating = TrueEnd Sub 字典求和和计数同时进行有了加总与计数，也可以求平均值：sum/count
Sub test()Dim d As ObjectDim key_cnt As LongDim key As StringDet d = CreateObject("scripting.dictionary")arr = ActiveSheet.UsedRangeFor i = 2 To UBound(arr) key = Join(Array(arr(i, 2), arr(i, 3)), "|") '如果字典该条键存在，累加 If d.exists(key) Then key_cnt = d(key)(0) + 1 '天数，计数+1 val_sum = d(key)(1) + arr(i, 4) '指标值加总 d(key) = Array(key_cnt, val_sum) Else '如果不存在，计数计算为1 d(key) = Array(1, arr(i, 4)) End IfNext' 求平均数for k in d.keys' 键 = array(计数，求和，平均数）d(k) = array(d(k)(0),d(k)(1),d(k)(1) / d(k)(0) ' 数组的第一个元素下标是0nextEnd Sub 类似sql的join操作有点像hive里面的mapjoin逻辑
示例：游戏名称join关联游戏类型