- 创建字典对象
'后期绑定:方便代码在其他电脑上运行,推荐。dim dic as objectSet dic = CreateObject("scripting.dictionary")'前期绑定:可以直接声明字典对象,有对象属性和方法的提示,但在其他没有勾选引用的电脑上无法正常运行。'引用勾选:VBE窗体-工具-引用-勾选‘Microsoft Scripting Runtime’dim dic as New dictionary
- 获取字典的键、值,字典计数,删除,判断键是否存在于字典
with activesheet 'dic.count:字典计数,字典中一共有多少条记录; 'dic.keys:字典的键,写入单元格以行写入,如需以列写入单元格,调用工作表函数transpose转置; .cells(1,1).resize(dic.count,1) = application.worksheetfunction.transpose(dic.keys) '清除工作表单元格内容 .cells.clearcontents 'dic.items:字典的值; .cells(1,1).resize(1,dic.count) = dic.items '判断某内容是否存在与字典的键中 if dic.exists("内容") then debug.print "字符串‘内容’存在于字典的键中" '清空字典,有时候其他过程也需要使用字典,当前过程已经使用完了,但我们又不想重新创建字典对象,这时候我们可以public字典全局变量,再清空字典,供新的过程使用该字典对象。 dic.removeall '清除单个字典键-值对,key是字典的某个需要删除的键 dic.remove keyend with
- 字典常用方法
- 去重
dim dic as objectdim arrdim stSet dic = CreateObject("scripting.dictionary")arr = array("可乐","雪碧","鸡翅",,"可乐","汉堡包","鸡翅")for each st in arr '字典的键是不能重复的,重复导入字典只会存在一个,可以利用字典这点特性去重。 '这里不需要字典的值,设置为空字符串或其他数值都可以。 dic(st) = ""nextactivesheet.range("a1").resize(dic.count,1) = application.worksheetfunction.transpose(d.keys)
- 实现sumifs条件求和
Sub dic_sumif()Application.ScreenUpdating = FalseDim dic As ObjectDim arrDim i As ByteSet dic = CreateObject("scripting.dictionary")With ActiveSheet arr = .UsedRange For i = 2 To UBound(arr) 'dic(arr(i,1))没有值是默认是0,通过下面方法对每一个水果的销量进行累加。 dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 2) Next '使用copy方法,将表头复制到e1,f1单元格 .Range("a1:b1").Copy .Range("e1") '字典键去重纵向写入到单元格 .Cells(2, "e").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) For i = 2 To dic.Count + 1 '循环输入字典键对应的值到f列 .Cells(i, "f").Value2 = dic(.Cells(i, "e").Value2) NextEnd Withset dic = NothingApplication.ScreenUpdating = TrueEnd Sub
效果如下图:
3. 计数
如果对上面水果种类进行计数:countifs,只需要将分类汇总的值改为数值1即可,每出现一次‘+1’
dic(arr(i, 1)) = dic(arr(i, 1)) + 1'在上面代码中添加下这条,修改下表头range("f1").value2 = "计数"
效果如下图:
4. 匹配
- 这个应该是使用字典应用最多的了,需要注意的是,如果使用单元格写入到字典,单元格同时也包含格式等信息,如果只需要单元格的值,要使用单元格.value2方法,同时,字典的值也可以是数组。
- 数据源:
- 目标:匹配‘李白’和‘后羿’的身高和体重
- 代码如下:
Sub data_match()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中,再输出匹配结果。
5. key的组合和分割
dim arrdim i,row as longdim d as objectdim keyset d = createobject("scripting.dictionary")with thisworkbook arr = .sheets(1).usedrange for i = 2 to ubound(arr) d(join(array(arr(i,1),arr(i,2),arr(i,3)),"|")) = arr(i,4) next with .sheets("输出") row = 2 for each key in d.keys .cells(row,4).value = d(key) .cells(row,1).resize(1,3) = split(key,"|") row = row + 1 next end withend with