這段時間頗有點邯鄲學步的感覺，由于把大量的時間和精力投入到python中抛蚤，之前學的vba到想用的時候，居然忘了寻狂。
作為非程序員岁经，編程向來當成"核導彈"來用，一次編寫出來蛇券，能用缀壤，好，很難再有機會寫第二遍代碼了纠亚，因為問題解決了诉位，以至于一直在遺忘的狀態(tài)，再想用的時候到處翻資料菜枷，筆記。
VBA字典技術
VBA字典在日常統(tǒng)計工作中是個十分有用的技術叁丧，但是在寫程序時啤誊，由于不熟練和個人記憶力有限，總要翻閱資料拥娄，于是產生將常用的字典技術匯集起來的想法蚊锹。
一、入門篇
字典: 是為字詞提供音韻稚瘾、意思解釋牡昆、例句、用法等等的工具書。
在VBA中字典與傳統(tǒng)理解的字典差不多：
1丢烘、都具有關鍵字（key）和值(item)一一對應的關系柱宦，
2、鍵具有唯一性播瞳。
VBA字典的作用掸刊，與數(shù)組的結合運用，簡化代碼（其實是犧牲內存赢乓，空間換取時間的用法忧侧，但在現(xiàn)時代通用的電腦普遍內存夠用的），提升速度等一些強大的功能牌芋。
字典不存在與VBA中蚓炬，需要調用，有兩種方法：
1躺屁、前期綁定肯夏，在EXCEL表格開發(fā)工具中，工具-引用-瀏覽-找到scrrun.dll-確定楼咳；
2熄捍、后期綁定，直接用代碼創(chuàng)建調用：Set d = CreateObject("scripting.dictionary")
本文主要采用后期綁定方式記錄字典用法母怜。
字典對象的方法有6個：
Add 添加一條關鍵字與條目
Keys 返回所有關鍵字(形成1維數(shù)組)
Items 返回所有條目(形成1維數(shù)組)
Exists 關鍵字是否存在(TRUE/FALSE)
Remove 移除關鍵字與對應的條目
RemoveAll 移除所有關鍵字與對應的條目
向 Dictionary 對象中添加一個關鍵字項目對余耽。
語法：object.Add (key, item)
Key，必選項苹熏。與被添加的 item 相關聯(lián)的 key碟贾。
Item，必選項轨域。與被添加的 key 相關聯(lián)的 item袱耽。
key 是唯一存在的，否則將導致一個錯誤干发。
實例1:
Sub kaishi()
'字典的鍵索引從零開始為第一個鍵
Dim d As New Dictionary, i, j, k, l
Set d = CreateObject("scripting.dictionary")
d.Add "張三", "15"
d.Add "李四", "18"
‘基礎取值方法
i = d.Keys(0)
j = Application.WorksheetFunction.Index(d.Keys, 2)
k = d.Keys ’keys會返回一個數(shù)組朱巨，所以可以用Index方法取值
l = k(1)
'Exists方法
'如果 Dictionary 對象中存在所指定的關鍵字則返回 true，否則返回 false枉长。
' a = d.Exists("李四")
'Remove方法
'Remove 方法從一個 Dictionary 對象中清除一個鍵——值對冀续。
d.Remove ("李四")
'RemoveAll方法
'RemoveAll 方法從一個 Dictionary 對象中清除所有鍵——值對。
d.RemoveAll
End Sub
字典對象的屬性有4個：
CompareMode屬性
Count屬性
Key屬性
Item屬性
實例2：
Sub test()
Set d = CreateObject("scripting.dictionary")
'1.CompareMode屬性
'設置或者返回在 Dictionary 對象中進行字符串關鍵字比較時所使用的比較模式必峰。
d.CompareMode = 0 '1則不區(qū)分大小寫洪唐，0則區(qū)分大小寫，默認為1
d.Add "a", ""
d.Add "A", ""
d.Add "張三", "13434544323"
d.Add "李四", "13589898999"
d.Add "王五", "13456565567"
'2.Count屬性
'返回一個Dictionary 對象中的項目數(shù).只讀屬性
k = d.Count
'3.Key屬性
'在 Dictionary 對象中修改一個 key吼蚁。
d.Key("王五") = "牛三斤"
'4.Item屬性
'在一個 Dictionary 對象中設置或者返回所指定 key 的 item凭需。對于集合則根據(jù)所指定的 key 返回一個 item。
i = d.Items
d.Item("張三") = "112233"
i = d.Items
d("張三") = 987 '簡寫方式
i = d.Items
'注意：容易混淆知識點。d.key("a")與d("a")
End Sub
二粒蜈、實戰(zhàn)篇
實例3：第一次與最后一次采購價格提取
在VBA中顺献，字典的鍵具有唯一性，采用add方法薪伏，如果有重復的鍵則會發(fā)生錯誤滚澜，根據(jù)這一特性，可以提取到第一次出現(xiàn)的鍵——值對嫁怀。
而采用d.item(key)=value替換方法设捐，新的鍵——值對會替換掉之前的鍵——值對，從而提取到最后一次鍵——值對塘淑。
由于d.keys與d.items都會形成標準的一維數(shù)組萝招，在寫入縱向的單元格時，需要通過transpose進行轉置存捺。
'求每種產品第一次采購價
Sub first()
Dim arr()
On Error Resume Next
Set d = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = 1 To UBound(arr)
d.Add arr(i, 1), arr(i, 2)
Next
[e1].Resize(d.Count) = Application.Transpose(d.keys)
[f1].Resize(d.Count) = Application.Transpose(d.items)
End Sub
'求每種產品最后一次采購價
Sub last()
Dim arr()
Set d = CreateObject("scripting.dictionary")
arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = arr(i, 2)
Next
[i1].Resize(d.Count) = Application.Transpose(d.keys)
[j1].Resize(d.Count) = Application.Transpose(d.items)
End Sub
實例4：多表求不重復值
值得一提的是d(key)=value方法槐沼，沒有就寫入，有就替換捌治，而且并不會隨著循環(huán)的改變清空其中的鍵——值對岗钩。
Sub test()
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
c = sh.Name
If sh.Name <> "品名" Then
?arr = sh.Range("a1:a" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
?For Each Rng In arr
? d(Rng) = ""
?Next
End If
Next
[a1].Resize(d.Count) = Application.Transpose(d.keys)
End Sub
實例5：字典與數(shù)組的結合運用
Sub test()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1:b" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row)
For Each Rng In arr
arr1 = VBA.Split(Rng, "|")
For Each rngs In arr1
?d(rngs) = ""
Next
i = VBA.Join(d.keys, "|")
n = n + 1
Sheet2.Cells(n, "a") = i
d.RemoveAll’清除本次循環(huán)的鍵值對
Next
End Sub
實例6：分類計算
字典可以通過鍵對應空值d(key)=d(key)+1，形成迭代計算從而統(tǒng)計出重復鍵出現(xiàn)次數(shù)肖油。
而d(key)=d(key)+value兼吓，形成替換累加效果。
Sub 分類計數(shù)()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For Each Rng In arr
i = d(Rng)
d(Rng) = d(Rng) + 1
i = d(Rng)
Next
[e1].Resize(d.Count) = Application.Transpose(d.keys)
[f1].Resize(d.Count) = Application.Transpose(d.items)
End Sub
Sub 分類求和()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:c" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
[e8].Resize(d.Count) = Application.Transpose(d.keys)
[f8].Resize(d.Count) = Application.Transpose(d.items)
End Sub
實例7：多列合并計算
此例在邏輯上挺繞的森枪，由于定義的動態(tài)數(shù)組arr(1 to 4, 1 to n),二維數(shù)組的第一維的下限不能為不確定值的變量视搏，所以通過多層轉置達到取值的目的。
Dim arr1()
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
?If Not d.exists(arr(i, 1)) Then
?n = n + 1
?d(arr(i, 1)) = n
?ReDim Preserve arr1(1 To 4, 1 To n)
?arr1(1, n) = arr(i, 1)
?arr1(2, n) = arr(i, 2)
?arr1(3, n) = arr(i, 3)
?arr1(4, n) = arr(i, 4)
Else
?m = d(arr(i, 1))
?arr1(2, m) = arr1(2, m) + arr(i, 2)
?arr1(3, m) = arr1(3, m) + arr(i, 3)
?arr1(4, m) = arr1(4, m) + arr(i, 4)
?End If
Next
[f2].Resize(n, 4) = Application.Transpose(arr1)
End Sub
實例8：條目數(shù)組用法
字典的鍵——值方式非常的靈活县袱，值甚至可以是數(shù)組浑娜。
Sub test() '條目數(shù)組用法
Set d = CreateObject("scripting.dictionary")
With Sheets("data")
arr = .Range("a2:e" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
For i = 1 To UBound(arr)
d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
j = d(arr(i, 1))
Next
For Each Rng In Range("a3:a" & Cells(Rows.Count, 1).End(xlUp).Row)
Rng.Offset(0, 1).Resize(1, 4) = d(Rng.Value)
Next
End Sub
總結:
字典在VBA中是種非常實用的技術，在實際運用中式散，與事件筋遭，控件等功能結合運用會產生一些非常實用神奇的操作。
