Sub 字典求和套路()Dim i, j, arr, brr, keyDim sht As WorksheetSet sht = Sheet1Application.Calculation = xlManualDim dicSet dic = CreateObject("scripting.dictionary")For i = 3 To sht.Cells(Rows.Count, "A").End(xlUp).Rowkey = sht.Cells(i, "A")dic(key) = dic(key) + sht.Cells(i, "C") '求和NextSheet3.Range("A2").Resize(10000, 2).ClearContents '清空結果區Sheet3.Range("A2").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items)) '結果區Application.Calculation = xlAutomatic
End Sub