VBA字典求和套路

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