vba实现分类汇总功能

Option Explicit
Sub test()
    Dim sht As Worksheet, rng As Range
    Set sht = ActiveSheet
    Dim i As Integer, index As Integer, subtotal As Double, dm As Variant
    Dim oldIndex As Integer, oldSubtotal As Double
    
    Dim startLine As Integer
    Dim lastLine As Integer
    
    startLine = 2
    lastLine = ActiveCell.CurrentRegion.Rows.Count
    
    dm = sht.Cells(lastLine, 2).Value
    subtotal = sht.Cells(lastLine, 3).Value
    index = lastLine
    For i = lastLine - 1 To startLine Step -1
        If dm <> sht.Cells(i, 2).Value Then
            dm = sht.Cells(i, 2).Value

            oldIndex = index
            oldSubtotal = subtotal

            index = i
            subtotal = sht.Cells(index, 3).Value

            sht.Cells(oldIndex + 1, 2).EntireRow.Insert
            sht.Cells(oldIndex + 1, 2).Value = "小计"
            sht.Cells(oldIndex + 1, 3).Value = oldSubtotal
        Else
            subtotal = subtotal + sht.Cells(i, 3).Value
        End If
        
        If i = startLine Then
            sht.Cells(index + 1, 2).EntireRow.Insert
            sht.Cells(index + 1, 2).Value = "小计"
            sht.Cells(index + 1, 3).Value = subtotal
       
        End If
        
    Next
    
End Sub