VBA字典用法集锦及代码详解

VBA字典用法集锦及代码详解一、字典基础认知1.字典核心优势字典（Dictionary）是VBA中高效的数据结构，本质是“键-值（Key-Item）”映射集合，核心优势：查找速度快（哈希表原理），百万级数据查询效率远超数组遍历；自动去重（Key值唯一），无需手动判断重复；支持动态增删改查，无需预设长度；可直接按Key索引值，无需遍历定位。2.适用场景数据去重与统计（如计数、求和）；两表数据匹配（如VLOOKUP功能升级）；快速查找与替换；复杂数据分组与分类汇总。3.引用与创建方式1：前期绑定（需添加引用）'步骤：工具→引用→勾选"MicrosoftScriptingRuntime"SubDict_Create_1()DimdictAsNewDictionary'声明并创建字典对象'核心属性验证Debug.Print"初始字典是否为空："&dict.IsEmpty'输出：TrueDebug.Print"初始字典条目数："&dict.Count'输出：0EndSub方式2：后期绑定（无需引用，兼容性更强）SubDict_Create_2()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")'动态创建字典'等价于前期绑定，推荐跨设备使用EndSub二、字典核心操作（增删改查）1.新增数据（Add方法）SubDict_Add()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")'1.基础添加：Key-Item成对添加（Key唯一）dict.AddKey:="姓名",Item:="张三"dict.Add"年龄",25'简化写法dict.Add"部门","技术部"'2.批量添加（数组遍历）DimarrAsVariant,iAsIntegerarr=Array("学历","本科","工龄",3,"薪资",15000)Fori=0ToUBound(arr)Step2IfNotdict.Exists(arr(i))Then'避免Key重复报错dict.Addarr(i),arr(i+1)EndIfNextiDebug.Print"添加后条目数："&dict.Count'输出：6EndSub注意：Key值不能重复，重复添加会报错，需用Exists方法提前判断。2.查询数据（Item属性/Exists方法）SubDict_Query()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")'先初始化数据dict.Add"A",100:dict.Add"B",200:dict.Add"C",300'1.按Key查询值（两种写法）Debug.Print"Key=B对应值："&dict("B")'直接索引，简洁Debug.Print"Key=C对应值："&dict.Item("C")'显式使用Item属性'2.判断Key是否存在（避免查询不存在的Key报错）DimkeyAsStringkey="D"Ifdict.Exists(key)ThenDebug.Printkey&"对应值："&dict(key)ElseDebug.Printkey&"不存在于字典中"'输出：D不存在于字典中EndIf'3.遍历所有Key（ForEach循环）Debug.PrintvbCrLf&"所有Key值："ForEachkeyIndict.KeysDebug.Printkey&"→"&dict(key)NextkeyEndSub3.修改数据（直接赋值）SubDict_Modify()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")dict.Add"产品","手机":dict.Add"价格",3999'1.修改已有Key的值（直接赋值覆盖）dict("价格")=4299'将价格从3999改为4299'2.不存在的Key赋值（自动新增条目）dict("库存")=100'等价于dict.Add"库存",100Debug.Print"修改后价格："&dict("价格")'输出：4299Debug.Print"新增库存："&dict("库存")'输出：100EndSub4.删除数据（Remove/RemoveAll方法）SubDict_Delete()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")dict.Add"1","苹果":dict.Add"2","香蕉":dict.Add"3","橙子"'1.删除指定Keydict.Remove"2"'删除Key=2的条目（香蕉）Debug.Print"删除后条目数："&dict.Count'输出：2'2.删除所有条目（清空字典）dict.RemoveAllDebug.Print"清空后条目数："&dict.Count'输出：0EndSub三、字典高级应用场景1.数据去重（Excel单元格去重）SubDict_RemoveDuplicates()DimdictAsObject,rngAsRange,cellAsRangeSetdict=CreateObject("Scripting.Dictionary")Setrng=Sheet1.Range("A1:A10")'待去重数据范围'1.加载数据到字典（Key自动去重）ForEachcellInrngIfcell.ValueAndNotdict.Exists(cell.Value)Thendict.Addcell.Value,""'Item值可留空，仅用Key去重EndIfNextcell'2.去重后结果输出到B列Sheet1.Range("B1:B"&dict.Count)=Application.Transpose(dict.Keys)MsgBox"去重完成！原数据"&rng.Cells.Count&"行，去重后"&dict.Count&"行"EndSub2.数据统计（计数/求和）场景：统计Excel中各产品销售数量SubDict_Statistics()DimdictAsObject,rngAsRange,iAsIntegerDimproductAsString,qtyAsIntegerSetdict=CreateObject("Scripting.Dictionary")Setrng=Sheet1.Range("A2:B100")'A列产品名，B列数量'1.遍历数据统计Fori=1Torng.Rows.Countproduct=rng.Cells(i,1).Valueqty=rng.Cells(i,2).ValueIfproductIfdict.Exists(product)Thendict(product)=dict(product)+qty'已有产品累加数量Elsedict(product)=qty'新产品添加初始数量EndIfEndIfNexti'2.统计结果输出到D:E列Sheet1.Range("D1")="产品":Sheet1.Range("E1")="总销量"Sheet1.Range("D2:D"&dict.Count+1)=Application.Transpose(dict.Keys)Sheet1.Range("E2:E"&dict.Count+1)=Application.Transpose(dict.Items)EndSub3.两表数据匹配（高效替代VLOOKUP）场景：表1（A:B列）按产品名匹配表2（D:E列）的单价SubDict_Vlookup()DimdictAsObject,ws1AsWorksheet,ws2AsWorksheetDimiAsInteger,lastRow1AsInteger,lastRow2AsIntegerSetdict=CreateObject("Scripting.Dictionary")Setws1=Sheet1:Setws2=Sheet2'1.表2数据加载到字典（Key=产品名，Item=单价）lastRow2=ws2.Cells(ws2.Rows.Count,"D").End(xlUp).RowFori=2TolastRow2'从第2行开始（跳过表头）Ifws2.Cells(i,"D").Valueists(ws2.Cells(i,"D").Value)Thendict.Addws2.Cells(i,"D").Value,ws2.Cells(i,"E").ValueEndIfNexti'2.表1匹配并填充单价lastRow1=ws1.Cells(ws1.Rows.Count,"A").End(xlUp).RowFori=2TolastRow1Ifdict.Exists(ws1.Cells(i,"A").Value)Thenws1.Cells(i,"C").Value=dict(ws1.Cells(i,"A").Value)'匹配成功填充单价Elsews1.Cells(i,"C").Value="无此产品"'匹配失败提示EndIfNextiMsgBox"数据匹配完成！"EndSub优势：百万级数据匹配速度比VLOOKUP快10-100倍，且支持反向匹配。4.字典与数组互转（批量处理数据）SubDict_Array_Convert()DimdictAsObject,arrAsVariant,arrKeysAsVariant,arrItemsAsVariantSetdict=CreateObject("Scripting.Dictionary")'1.字典转数组（Keys/Items属性）dict.Add"A",1:dict.Add"B",2:dict.Add"C",3arrKeys=dict.Keys'键数组：{"A","B","C"}arrItems=dict.Items'值数组：{1,2,3}Debug.Print"键数组第2个元素："&arrKeys(1)'输出：B（数组索引从0开始）Debug.Print"值数组第3个元素："&arrItems(2)'输出：3'2.二维数组转字典DimarrDataAsVariant,iAsIntegerarrData=Sheet1.Range("A1:B5").Value'二维数组（5行2列）dict.RemoveAll'清空字典Fori=1ToUBound(arrData,1)'遍历行（UBound(arrData,1)获取行数）dict.AddarrData(i,1),arrData(i,2)'第1列当Key，第2列当ItemNextiDebug.PrintvbCrLf&"二维数组转字典后："ForEachkeyIndict.KeysDebug.Printkey&"→"&dict(key)NextkeyEndSub5.多条件匹配（复合Key）场景：按“产品+地区”双条件匹配销售额SubDict_MultiCondition()DimdictAsObject,iAsIntegerDimcompositeKeyAsString'复合Key（产品+地区）Setdict=CreateObject("Scripting.Dictionary")'加载数据：A列产品，B列地区，C列销售额Fori=2ToSheet1.Cells(Sheet1.Rows.Count,"A").End(xlUp).RowcompositeKey=Sheet1.Cells(i,"A").Value&"|"&Sheet1.Cells(i,"B").Value'用分隔符拼接dict(compositeKey)=Sheet1.Cells(i,"C").Value'直接赋值（自动去重）Nexti'匹配查询：产品=手机，地区=北京DimtargetKeyAsStringtargetKey="手机|北京"Ifdict.Exists(targetKey)ThenMsgBox"手机（北京）销售额："&dict(targetKey)ElseMsgBox"无匹配数据"EndIfEndSub注意：复合Key需用特殊分隔符（如|、#），避免与数据本身冲突。四、字典常见问题与注意事项1.Key值数据类型限制Key值支持字符串、数字、日期等，但不能是数组或对象；数字型Key与字符串型Key视为不同（如dict.Add1,"a"与dict.Add"1","b"可共存）。2.避免报错的关键判断新增前用dict.Exists(Key)判断是否重复；查询前用dict.Exists(Key)避免Key不存在报错；遍历删除时需先转数组（直接遍历字典Keys删除会报错）：'错误写法：ForEachkeyIndict.Keys→删除时改变集合导致遍历中断'正确写法：DimarrKeysAsVariant,keyAsVariantarrKeys=dict.KeysForEachkeyInarrKeysIfkey="无用数据"Thendict.RemovekeyNextkey3.字典与数组性能对比操作场景字典数组推荐选择随机查找极快（O(1)）慢（O(n)）字典数据去重自动去重需手动遍历字典批量读写一般极快数组（批量加载后转字典处理）内存占用较高较低数据量小时用数组，大时用字典4.释放内存SubDict_ReleaseMemory()DimdictAsObjectSetdict=CreateObject("Scripting.Dictionary")'业务处理...'释放内存（避免内存泄漏）dict.RemoveAllSetdict=Nothing'关键：解除对象引用EndSub五、实用工具函数（直接调用）1.字典快速去重函数'功能：对指定范围数据去重，返回去重后数组FunctionDict_Unique(rngAsRange)AsVariantDimdictAsObject,cellAsRangeSetdict=CreateObject("Scripting.Dictionary")ForEachcellInrngIfcell.Value""AndNotdict.Exists(cell.Value)Thendict.Addcell.Value,""EndIfNextcellIfdict.Count>0ThenDict_Unique=Application.Transpose(dict