實例9 實例10
實例9 字典取行數(shù)，數(shù)組重新賦值
一、問題的提出：
要求編寫一段代碼，求得B列不重復(fù)的名字，其相應(yīng)的A列和D列分別用" "連起來，而相應(yīng)的E列F列的數(shù)值分別相加匯總。
代碼執(zhí)行前如圖實例8-1所示。
二、代碼：Sub yy() 'by:Zamyi
Dim d As New Dictionary, R
Dim k, i&, j&
R = Sheet1.UsedRange
k = 1
For i = 2 To UBound(R)
R(i, 2) = Replace(Replace(R(i, 2), "（", "("), "）", ")")
If d.Exists(R(i, 2)) Then
R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & " " & R(i, 1)
R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & " " & R(i, 4)
R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5)
R(d(R(i, 2)), 6) = Val(R(d(R(i, 2)), 6)) + R(i, 6)
Else
k = k + 1
d(R(i, 2)) = i
For j = 1 To UBound(R, 2)
R(k, j) = R(i, j)
Next
End If
Next
With Sheet2
.Cells.ClearContents
.Cells.Borders.LineStyle = xlNone
.[a1:F1].Resize(d.Count + 1) = R
.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1
End With
Set d = Nothing
End Sub
復(fù)制代碼
三、代碼詳解
1、R = Sheet1.UsedRange ：把表1的已經(jīng)使用了的單元格區(qū)域的值賦給變量R。
2、k = 1 ：變量k賦初值1。
3、For i = 2 To UBound(R) ：由于第一行是表頭，所以從第2行開始循環(huán)。
4、R(i, 2) = Replace(Replace(R(i, 2), "（", "("), "）", ")") ：由于源數(shù)據(jù)中用了不統(tǒng)一的括號，所以加了這句把里面中文括號統(tǒng)一替換為英文括號。這句用了兩次VBA函數(shù)Replace，一次替換前半個，另一次替換后半個。Replace函數(shù)有6個參數(shù)，詳細(xì)請查閱VBA幫助文件。如果在這里解釋，篇幅太長了，也沖淡了字典的主題。
5、If d.Exists(R(i, 2)) Then ：這句用字典的Exists方法進(jìn)行判斷，如果字典中存在R(i, 2)這個關(guān)鍵字，那么執(zhí)行下面的代碼。
6、這里先解釋，Else如果上面的判斷不成立，即字典中不存在這個關(guān)鍵字時，要執(zhí)行下面的代碼。
7、k = k + 1 ：變量k+1以后再賦給k。
8、d(R(i, 2)) = i ：公司名字作為關(guān)鍵字，對應(yīng)的項是它所在的行，把它們加入字典d。
9、For j = 1 To UBound(R, 2) ：知道了這個關(guān)鍵字所在的行，下面這個循環(huán)就是重新給數(shù)組同一行的各個元素賦值。UBound(R, 2)是用VBA函數(shù)Ubound求得數(shù)組R的第2維的最大上界。比如本例R數(shù)組第1維的最大上界是8，有8行數(shù)據(jù)；而第2維的最大上界是6，有6列數(shù)據(jù)。本循環(huán)j就是從第1列到第6列依次循環(huán)。
10、R(k, j) = R(i, j) ：把i行j列的數(shù)組元素賦給k行j列的R數(shù)組元素。
11、R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & " " & R(i, 1) ：再回來說如果R(i, 2)這個關(guān)鍵字存在，則執(zhí)行這條代碼。在這之前，這關(guān)鍵字已經(jīng)加入字典了，它的同一行的各個數(shù)組元素也重新賦過值了，所以根據(jù)問題的要求，把A列的數(shù)據(jù)用" "連起來再賦給A列這個數(shù)組元素。
12、R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & " " & R(i, 4) ：D列數(shù)據(jù)同上。
13、R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5) ：E 列數(shù)據(jù)要相加，這里用了VBA函數(shù)Val，把E列數(shù)組元素轉(zhuǎn)為數(shù)值以后相加匯總。下句類同。
14、With Sheet2 ：With語句，前面介紹過的。
15、.Cells.ClearContents ：清空表2所有的數(shù)據(jù)。Cells是工作表對象的屬性，指工作表所有的單元格；ClearContents是它的方法，清除里面的公式、數(shù)據(jù)，但是保留格式設(shè)置。
16、.Cells.Borders.LineStyle = xlNone ：清除表2所有的邊框。Borders是Cells的屬性，意思是單元格的邊框；LineStyle是邊框的屬性，為邊框的線型，它有直線、虛線、點劃線等等，這里取值xlNone是清除邊框。
17、.[a1:F1].Resize(d.Count + 1) = R ：把數(shù)組R的值賦給表2A1單元格開始的區(qū)域。
18、.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1 ：給這些單元格添加邊框，線型為直線。
代碼執(zhí)行后如圖實例9-2所示。
實例10 先字典求得行后顯示整行數(shù)據(jù)
一、問題的提出：
有3列數(shù)據(jù)，要求編寫一段代碼，如果C列名次、A列主排相同時，根據(jù)B列次排最大的只保留一行。
解題思路：先對3列數(shù)據(jù)按主要關(guān)鍵字名次_升序，次要關(guān)鍵字主排_升序，第3關(guān)鍵字次排_降序進(jìn)行排序，然后運用字典，以”名次|主排” 作為關(guān)鍵字，它所在的行作為關(guān)鍵字的項加入字典，最后根據(jù)行引用相對的單元格值。
代碼執(zhí)行前如圖實例10-1所示。
二、代碼：Sub pmc()
Dim i&, Myr&, Arr
Dim d, x, rng
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
Myr = [a65536].End(xlUp).Row
Range("A1:C" & Myr).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range( _
"A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending, _
Header:=xlYes
Arr = Range("a2:c" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 1) & "|" & Arr(i, 3)
If Not d.exists(x) Then
d.Add x, i + 1
End If
Next
[e:g].ClearContents
[e2].Resize(d.Count, 1) = Application.Transpose(d.items)
For Each rng In [e2].Resize(d.Count, 1)
rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value
Next
Set d = Nothing
Application.ScreenUpdating = True
End Sub
復(fù)制代碼
三、代碼詳解
1、Application.ScreenUpdating = False ：關(guān)閉屏幕更新。關(guān)閉屏幕更新可加快宏的執(zhí)行速度。請記住當(dāng)宏結(jié)束執(zhí)行時，將 ScreenUpdating 屬性設(shè)回到 True。
2、Range("A1:C" & Myr).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending, _
Header:=xlYes ：對ABC三列進(jìn)行排序。主要關(guān)鍵字Key1名次_升序，次要關(guān)鍵字Key2主排_升序，第3關(guān)鍵字Key3次排_降序。
3、Arr = Range("a2:c" & Myr) ：把ABC列數(shù)據(jù)賦給變量Arr。
4、For i = 1 To UBound(Arr) ：i從1到數(shù)組Arr的最大上界逐一循環(huán)。
5、x = Arr(i, 1) & "|" & Arr(i, 3) ：把主排和”|”和名次連起來賦給變量x。
6、If Not d.exists(x) Then ：如果字典中不存在x這個關(guān)鍵字，那么執(zhí)行下面的代碼。
7、d.Add x, i + 1 ：把x作為關(guān)鍵字和這個關(guān)鍵字的具體的行作為對應(yīng)的項加入字典。因為數(shù)組Arr是從A2開始的，所以i與數(shù)據(jù)的實際行相差1，i+1就是數(shù)據(jù)的實際行。
8、[e:g].ClearContents ：清空E~G列。
9、[e2].Resize(d.Count, 1) = Application.Transpose(d.items) ：把字典所有的項轉(zhuǎn)置以后賦給E2單元格開始的區(qū)域。
10、For Each rng In [e2].Resize(d.Count, 1) ：For- Each-Next控制結(jié)構(gòu)是VBA中功能最強的循環(huán)控制結(jié)構(gòu)，利用這個結(jié)構(gòu)可對集合中的所有對象或者數(shù)組中的所有元素進(jìn)行同一操作。它的一個優(yōu)點在于你不必操心循環(huán)應(yīng)該執(zhí)行多少次，它循環(huán)的次數(shù)恰好就是數(shù)組中元素的個數(shù)（或者集合中對象的個數(shù)），因此對于處理多維數(shù)組特別是處理對象時最有效率。本句意思是在E2單元格開始的單元格區(qū)域中逐一循環(huán)。
11、rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value ：把關(guān)鍵字所在行的3個單元格的值賦給rng開始的3個單元格。在Cells(rng, 1)中作為參數(shù)的rng＝rng.Valur，而rng.Resize(1, 3)處的rng是一個單元格對象。
代碼執(zhí)行后如圖實例10-2所示。
doc文件（全）請到1樓下載。
