EXCEL如何用VBA數據字典：除去重復後匯總

Sub main()

Set dic = CreateObject("scripting.dictionary") '定義詞典

arr = Range("A1:C500") '假設最大行數為500，將A1至C500區域放入數組

For i = 1 To UBound(arr) '從1到數組最大行數循環

If arr(i, 1) <> "" And arr(i, 1) <> "裝置" Then '提出空格和標題行

dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 3) '用字典去除重復，並且進行數量累加

End If

Next i

[e2].Resize(dic.Count, 1) = Application.Transpose(dic.keys) '將字典的keys(即A列不重復的值)轉置並放在E列

[f2].Resize(dic.Count, 1) = Application.Transpose(dic.items) '將字典的kItems（即累加結果)轉置並放在E列

End Sub