EXCEL通过VBA字典快速分类求和

汇总截图

Option ExplicitOption Explicit
Sub answer3()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = ThisWorkbook
Set sht = wb.Worksheets(2)
Dim ss1 As Integer
Dim ss2 As Integer
Dim i As Integer
Dim j As Integer
j = 1Dim aa()Dim b()Dim a()Dim d As Object, k As StringDim wReport As Worksheet, w As WorksheetSet w = wb.Worksheets(1)Set wReport = Worksheets(1)Set d = CreateObject("scripting.dictionary")aa = sht.UsedRangess1 = sht.UsedRange.Rows.Countss2 = UBound(aa)For i = 1 To UBound(aa)k = Trim(aa(i, 1))If k <> "部门" ThenIf d.exists(k) Thend.Item(k) = CDbl(d.Item(k)) + CDbl(Trim(aa(i, 2)))Elsed.Add k, CDbl(Trim(aa(i, 2)))End IfEnd IfNext ii = d.CountIf i > 0 ThenDim Item As VariantFor Each Item In d.keys()w.Cells(j, 1) = Itemw.Cells(j, 2) = d(Item)j = j + 1Next
'        a = d.keys()
'        b = d.items()
'        w.Range(Cells(1, 1), Cells(i + 3, 1)) = Application.Transpose(a)
'        w.Range(Cells(1, 2), Cells(i + 3, 2)) = Application.Transpose(b)End IfEnd Sub