這段時(shí)間頗有點(diǎn)邯鄲學(xué)步的感覺(jué),由于把大量的時(shí)間和精力投入到python中,之前學(xué)的vba到想用的時(shí)候,居然忘了。
作為非程序員,編程向來(lái)當(dāng)成"核導(dǎo)彈"來(lái)用,一次編寫(xiě)出來(lái),能用,好,很難再有機(jī)會(huì)寫(xiě)第二遍代碼了,因?yàn)閱?wèn)題解決了,以至于一直在遺忘的狀態(tài),再想用的時(shí)候到處翻資料,筆記。
VBA字典技術(shù)
VBA字典在日常統(tǒng)計(jì)工作中是個(gè)十分有用的技術(shù),但是在寫(xiě)程序時(shí),由于不熟練和個(gè)人記憶力有限,總要翻閱資料,于是產(chǎn)生將常用的字典技術(shù)匯集起來(lái)的想法。
一、入門(mén)篇
字典: 是為字詞提供音韻、意思解釋、例句、用法等等的工具書(shū)。
在VBA中字典與傳統(tǒng)理解的字典差不多:
1、都具有關(guān)鍵字(key)和值(item)一一對(duì)應(yīng)的關(guān)系,
2、鍵具有唯一性。
VBA字典的作用,與數(shù)組的結(jié)合運(yùn)用,簡(jiǎn)化代碼(其實(shí)是犧牲內(nèi)存,空間換取時(shí)間的用法,但在現(xiàn)時(shí)代通用的電腦普遍內(nèi)存夠用的),提升速度等一些強(qiáng)大的功能。
字典不存在與VBA中,需要調(diào)用,有兩種方法:
1、前期綁定,在EXCEL表格開(kāi)發(fā)工具中,工具-引用-瀏覽-找到scrrun.dll-確定;
2、后期綁定,直接用代碼創(chuàng)建調(diào)用:Set d = CreateObject("scripting.dictionary")
本文主要采用后期綁定方式記錄字典用法。
字典對(duì)象的方法有6個(gè):
Add 添加一條關(guān)鍵字與條目
Keys 返回所有關(guān)鍵字(形成1維數(shù)組)
Items 返回所有條目(形成1維數(shù)組)
Exists 關(guān)鍵字是否存在(TRUE/FALSE)
Remove 移除關(guān)鍵字與對(duì)應(yīng)的條目
RemoveAll 移除所有關(guān)鍵字與對(duì)應(yīng)的條目
向 Dictionary 對(duì)象中添加一個(gè)關(guān)鍵字項(xiàng)目對(duì)。
語(yǔ)法:object.Add (key, item)
Key,必選項(xiàng)。與被添加的 item 相關(guān)聯(lián)的 key。
Item,必選項(xiàng)。與被添加的 key 相關(guān)聯(lián)的 item。
key 是唯一存在的,否則將導(dǎo)致一個(gè)錯(cuò)誤。
實(shí)例1:
Sub kaishi()
'字典的鍵索引從零開(kāi)始為第一個(gè)鍵
Dim d As New Dictionary, i, j, k, l
Set d = CreateObject("scripting.dictionary")
d.Add "張三", "15"
d.Add "李四", "18"
‘基礎(chǔ)取值方法
i = d.Keys(0)
j = Application.WorksheetFunction.Index(d.Keys, 2)
k = d.Keys ’keys會(huì)返回一個(gè)數(shù)組,所以可以用Index方法取值
l = k(1)
'Exists方法
'如果 Dictionary 對(duì)象中存在所指定的關(guān)鍵字則返回 true,否則返回 false。
' a = d.Exists("李四")
'Remove方法
'Remove 方法從一個(gè) Dictionary 對(duì)象中清除一個(gè)鍵——值對(duì)。
d.Remove ("李四")
'RemoveAll方法
'RemoveAll 方法從一個(gè) Dictionary 對(duì)象中清除所有鍵——值對(duì)。
d.RemoveAll
End Sub
字典對(duì)象的屬性有4個(gè):
CompareMode屬性
Count屬性
Key屬性
Item屬性
實(shí)例2:
Sub test()
Set d = CreateObject("scripting.dictionary")
'1.CompareMode屬性
'設(shè)置或者返回在 Dictionary 對(duì)象中進(jìn)行字符串關(guān)鍵字比較時(shí)所使用的比較模式。
d.CompareMode = 0 '1則不區(qū)分大小寫(xiě),0則區(qū)分大小寫(xiě),默認(rèn)為1
d.Add "a", ""
d.Add "A", ""
d.Add "張三", "13434544323"
d.Add "李四", "13589898999"
d.Add "王五", "13456565567"
'2.Count屬性
'返回一個(gè)Dictionary 對(duì)象中的項(xiàng)目數(shù).只讀屬性
k = d.Count
'3.Key屬性
'在 Dictionary 對(duì)象中修改一個(gè) key。
d.Key("王五") = "牛三斤"
'4.Item屬性
'在一個(gè) Dictionary 對(duì)象中設(shè)置或者返回所指定 key 的 item。對(duì)于集合則根據(jù)所指定的 key 返回一個(gè) item。
i = d.Items
d.Item("張三") = "112233"
i = d.Items
d("張三") = 987 '簡(jiǎn)寫(xiě)方式
i = d.Items
'注意:容易混淆知識(shí)點(diǎn)。d.key("a")與d("a")
End Sub
二、實(shí)戰(zhàn)篇
實(shí)例3:第一次與最后一次采購(gòu)價(jià)格提取

在VBA中,字典的鍵具有唯一性,采用add方法,如果有重復(fù)的鍵則會(huì)發(fā)生錯(cuò)誤,根據(jù)這一特性,可以提取到第一次出現(xiàn)的鍵——值對(duì)。
而采用d.item(key)=value替換方法,新的鍵——值對(duì)會(huì)替換掉之前的鍵——值對(duì),從而提取到最后一次鍵——值對(duì)。
由于d.keys與d.items都會(huì)形成標(biāo)準(zhǔn)的一維數(shù)組,在寫(xiě)入縱向的單元格時(shí),需要通過(guò)transpose進(jìn)行轉(zhuǎn)置。
'求每種產(chǎn)品第一次采購(gòu)價(jià)
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
'求每種產(chǎn)品最后一次采購(gòu)價(jià)
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
實(shí)例4:多表求不重復(fù)值
值得一提的是d(key)=value方法,沒(méi)有就寫(xiě)入,有就替換,而且并不會(huì)隨著循環(huán)的改變清空其中的鍵——值對(duì)。

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
實(shí)例5:字典與數(shù)組的結(jié)合運(yùn)用

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)的鍵值對(duì)
Next
End Sub
實(shí)例6:分類(lèi)計(jì)算
字典可以通過(guò)鍵對(duì)應(yīng)空值d(key)=d(key)+1,形成迭代計(jì)算從而統(tǒng)計(jì)出重復(fù)鍵出現(xiàn)次數(shù)。
而d(key)=d(key)+value,形成替換累加效果。

Sub 分類(lèi)計(jì)數(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 分類(lèi)求和()
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
實(shí)例7:多列合并計(jì)算
此例在邏輯上挺繞的,由于定義的動(dòng)態(tài)數(shù)組arr(1 to 4, 1 to n),二維數(shù)組的第一維的下限不能為不確定值的變量,所以通過(guò)多層轉(zhuǎn)置達(dá)到取值的目的。

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
實(shí)例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
總結(jié):
字典在VBA中是種非常實(shí)用的技術(shù),在實(shí)際運(yùn)用中,與事件,控件等功能結(jié)合運(yùn)用會(huì)產(chǎn)生一些非常實(shí)用神奇的操作。