|
如上圖所示，要求：
1、用代碼為左表中單元格賦值。（說明：以下相應(yīng)的代碼只是為了記錄相關(guān)的使用方法，實(shí)際應(yīng)用中并不需要這么麻煩。）
2、把左表中不重復(fù)的姓名統(tǒng)計到右表中，重復(fù)人員籍貫按后出現(xiàn)的籍貫為準(zhǔn)，統(tǒng)計每個姓名出現(xiàn)的次數(shù)，以及每人累計銷售量。
代碼如下：
Private Sub CommandButton1_Click()
[A:H].ClearContents
'Dim d1 As Object, d2 As Object, d3 As Object, k, t '逐個定義字典對象
Dim dic(1 To 3) As Object, k, t '多個字典對象可定義為數(shù)組
'Set d1 = CreateObject("scripting.dictionary")
Set dic(1) = CreateObject("scripting.dictionary")
Set dic(2) = CreateObject("scripting.dictionary")
Set dic(3) = CreateObject("scripting.dictionary")
dic(1).Add "xm1", "jg1"
dic(1).Add "xm2", "jg2"
dic(1).Add "xm3", "jg3"
'dic(1).Item("xm3") = "jg100" '把關(guān)鍵字xm3的項(xiàng)改為“jg100”
'If dic(1).exists("xm3") Then
' MsgBox "指定的關(guān)鍵字xm3存在。"
'End If
k = dic(1).keys '把字典對象dic(1)中的關(guān)鍵字賦給變量k
t = dic(1).items '把字典對象dic(1)中的項(xiàng)賦給變量t
'加標(biāo)題行內(nèi)容
[A1].Resize(1, 8) = Array("姓名（有重復(fù)）", "籍貫", "銷售", "", "姓名（無重復(fù)）", "籍貫", "同一姓名出現(xiàn)次數(shù)", "銷售總量")
'把變量k、t分別賦給A2和B2單元格開始的列中(需轉(zhuǎn)置)
[A2].Resize(dic(1).Count, 1) = Application.Transpose(k)
[B2].Resize(dic(1).Count, 1) = Application.Transpose(t)
'A5開始的5行2列單元格區(qū)域用數(shù)組公式賦值
[A5].Resize(5, 2).FormulaArray = _
"={""xm4"",""jg4"";""xm2"",""jg5"";""xm6"",""jg6"";""xm1"",""jg7"";""xm8"",""jg8""}"
'“銷售”列賦值
[C2].Resize(8, 1).FormulaArray = _
"={100;200;300;400;500;600;700;800}"
Dim iRow As Long, i As Long, Arr
iRow = Sheet1.[A65536].End(xlUp).Row
Arr = Sheet1.Range("A1:C" & iRow)
'從第5行開始，把關(guān)鍵字“姓名”加入字典(因?yàn)榈?行開始的5行2列數(shù)據(jù)是用數(shù)組公式賦值的，關(guān)鍵字中不一定有)。
'如果關(guān)鍵字中沒有該“姓名”，則把該“姓名”和“籍貫”加入關(guān)鍵字和項(xiàng)中；
'如果關(guān)鍵字中已有該“姓名”，則相應(yīng)的項(xiàng)取其最后一次出現(xiàn)的“籍貫”
For i = 5 To UBound(Arr)
dic(1)(Arr(i, 1)) = Cells(i, 2)
Next
'計數(shù)，求和
For i = 2 To UBound(Arr) '因?yàn)橛袠?biāo)題行，所以從第2行開始
dic(2)(Arr(i, 1)) = dic(2)(Arr(i, 1)) + 1 '計數(shù)，統(tǒng)計關(guān)鍵字“姓名”出現(xiàn)的次數(shù)。關(guān)鍵字“姓名”每出現(xiàn)一次，其項(xiàng)加1
dic(3)(Arr(i, 1)) = dic(3)(Arr(i, 1)) + Arr(i, 3) '求和，累計“銷售”的總量。關(guān)鍵字“姓名”每出現(xiàn)一次，把“銷售”累加進(jìn)項(xiàng)中
'dic(4)(Arr(i, 1) & "|" & Arr(i, 3)) = i '保留行號
Next
'--------------------------------------------------------------------------------------------------------------------------------
'先用字典求得符合條件的行號，再通過行號顯示整行數(shù)據(jù)
'================================================================================================================================
'如果符合條件的行號已經(jīng)保存到字典對象dic(4)的項(xiàng)中，假如現(xiàn)在要把原表中符合條件的3列數(shù)據(jù)顯示在J2:L2向下的區(qū)域中，
'Dim Rng As Range
'[J:L].ClearContents
'[J2].Resize(dic(4).Count, 1) = Application.Transpose(dic(4).items) '因?yàn)轫?xiàng)中保存的是符合條件的行號
' '本行代碼即：先把符合條件的行號賦給J2開始的列中
'For Each Rng In [J2].Resize(dic(4).Count, 1)
' 'Cells(Rng, 1)中作為參數(shù)的Rng＝Rng.Value，而Rng.Resize(1, 3)處的Rng是一個單元格對象。
' Rng.Resize(1, 3) = Cells(Rng, 1).Resize(1, 3).Value
'Next
'--------------------------------------------------------------------------------------------------------------------------------
[E2].Resize(dic(1).Count, 1) = Application.Transpose(dic(1).keys)
[F2].Resize(dic(1).Count, 1) = Application.Transpose(dic(1).items)
[G2].Resize(dic(2).Count, 1) = Application.Transpose(dic(2).items)
[H2].Resize(dic(3).Count, 1) = Application.Transpose(dic(3).items)
'釋放字典內(nèi)存
Set dic(1) = Nothing
Set dic(2) = Nothing
Set dic(3) = Nothing
End Sub
|
