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