VBA字典

本文链接：https://blog.csdn.net/me_to_007/article/details/89789378

创建字典对象

'后期绑定：方便代码在其他电脑上运行，推荐。
dim dic as object
Set 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 key
end with

字典常用方法

去重

dim dic as object
dim arr
dim st
Set dic = CreateObject("scripting.dictionary")

arr = array("可乐","雪碧","鸡翅",,"可乐","汉堡包","鸡翅")
for each st in arr
	'字典的键是不能重复的，重复导入字典只会存在一个，可以利用字典这点特性去重。
	'这里不需要字典的值，设置为空字符串或其他数值都可以。
	dic(st) = ""
next
activesheet.range("a1").resize(dic.count,1) = application.worksheetfunction.transpose(d.keys)

实现sumifs条件求和

Sub dic_sumif()
Application.ScreenUpdating = False
Dim dic As Object
Dim arr
Dim i As Byte

Set 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)
    Next
End With
set dic = Nothing
Application.ScreenUpdating = True
End Sub

效果如下图：
在这里插入图片描述
3. 计数
如果对上面水果种类进行计数：countifs，只需要将分类汇总的值改为数值1即可，每出现一次‘+1’

dic(arr(i, 1)) = dic(arr(i, 1)) + 1

'在上面代码中添加下这条，修改下表头
range("f1").value2 = "计数"

效果如下图：
在这里插入图片描述
4. 匹配

这个应该是使用字典应用最多的了，需要注意的是，如果使用单元格写入到字典，单元格同时也包含格式等信息，如果只需要单元格的值，要使用单元格.value2方法，同时，字典的值也可以是数组。
数据源：
目标：匹配‘李白’和‘后羿’的身高和体重
代码如下：

Sub data_match()
Application.ScreenUpdating = False
Dim dic As Object
Dim arr
Dim i As Byte

Set 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)
    Next
End With
set dic = Nothing
Application.ScreenUpdating = True
End Sub

效果如下：
我在这里加入了‘妲己’，遍历用字典去匹配了，但是字典并没有‘妲己’这个key，匹配出来是空，并没有报错，大家不用担心字典没有对应key匹配而出错这种情况，这样只会将结果输出为空。~
如果需要匹配的姓名后面有之前填写的身高和体重信息，但是载入字典的数据源并没有这个人的信息，我们在遍历匹配时，又不想使身高和体重被替换为空，这时候可以结合dic.exisst语句，判断姓名是否存在于字典的keys中，再输出匹配结果。
在这里插入图片描述
5. key的组合和分割

dim arr
dim i,row as long
dim d as object
dim key

set 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 with
end with