Sub 字典求和套路()
   Dim i, j, arr, brr, key
   Dim sht As Worksheet
   Set sht = Sheet1
   Application.Calculation = xlManual
   Dim dic
   Set dic = CreateObject("scripting.dictionary")
   
   For i = 3 To sht.Cells(Rows.Count, "A").End(xlUp).Row
       key = sht.Cells(i, "A")
       dic(key) = dic(key) + sht.Cells(i, "C") '求和
   Next
   
   Sheet3.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