大家好， 今天和大家分享“這樣的資料統計讓人無語”， 問題是這樣的， 這位朋友提出這樣一問題， 按A列姓名和B列物品對C列的數量進行匯總， 本來這種題應該用透視表做最好了， 且一目了然， 而這位朋友非要vba實現下面的E， F列效果， 真讓人無語啊|更多Excel學習和問題請加群：289393114、570064677
一、提問者原話：
單單這個問題用樞紐分析表我可以搞定， 但是我現在是想瞭解這個用VBA怎麼寫， 別的相關資料都是用VBA做， 不可能這個用樞紐分析表， 而且我夜想學學這個怎麼寫！！有空幫我寫個唄， 謝謝了！！！
二、透視表實現
1、最後效果
2、動畫操作步驟
三、vba程式設計實現
1、統計出來的效果
2、動畫操作方法
3、代碼
Option Explicit
Sub test100()
Dim Dic, arr1, x, k, y, Dic1, arr3(1 To 100000, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic1 = CreateObject("Scripting.Dictionary")
arr1 = Range("A1").CurrentRegion
ReDim arr2(1 To UBound(arr1), 1 To UBound(arr1, 2))
For x = 2 To UBound(arr1)
If Not Dic.exists(arr1(x, 1) & arr1(x, 2)) Then
k = k + 1
Dic(arr1(x, 1) & arr1(x, 2)) = k
arr2(k, 1) = arr1(x, 1)
arr2(k, 2) = arr1(x, 2)
arr2(k, 3) = arr1(x, 3)
Else
arr2(Dic(arr1(x, 1) & arr1(x, 2)), 3) = arr2(Dic(arr1(x, 1) & arr1(x, 2)), 3) + arr1(x, 3)
End If
Next x
'============================
For x = 2 To UBound(arr1)
Dic1(arr1(x, 1)) = ""
Next x
For x = 1 To Dic1.Count
For y = 1 To k
If arr2(y, 1) = Dic1.keys()(x - 1) Then
arr3(x, 1) = arr3(x, 1) & arr2(y, 2) & "*" & arr2(y, 3)
End If
Next y
Next x
Range("E1").CurrentRegion.Clear
[E1] = "姓名": [F1] = "備註"
[E2].Resize(Dic1.Count, 1) = Application.Transpose(Dic1.keys)
[F2].Resize(Dic.Count, 1) = arr3
End Sub
'備註：D列要是空