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

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

汇总截图

Option Explicit

Option 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 = 1
    Dim aa()
    Dim b()
    Dim a()
    Dim d As Object, k As String
    Dim wReport As Worksheet, w As Worksheet
    Set w = wb.Worksheets(1)
    Set wReport = Worksheets(1)
    Set d = CreateObject("scripting.dictionary")
            aa = sht.UsedRange
            ss1 = sht.UsedRange.Rows.Count
            ss2 = UBound(aa)
            For i = 1 To UBound(aa)
                k = Trim(aa(i, 1))
                  If k <> "部门" Then
                    If d.exists(k) Then
                        d.Item(k) = CDbl(d.Item(k)) + CDbl(Trim(aa(i, 2)))
                    Else
                        d.Add k, CDbl(Trim(aa(i, 2)))
                    End If
                  End If
            Next i
       
    

    i = d.Count
    If i > 0 Then
    Dim Item As Variant
    For Each Item In d.keys()
        w.Cells(j, 1) = Item
        w.Cells(j, 2) = d(Item)
        j = j + 1
    Next
'        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 If
    
    
    
End Sub