如何用VBA在表格行间添加带求和计算/公式的汇总行？

现有表格：

需要用VBA实现以下效果：

• 同类水果行后添加对应求和行
• 添加苹果与橙子的合计行
• 最后添加总计行
• 新增行的求和值可用SUM公式或VBA计算

目标表格：

我尝试了以下VBA代码，但逻辑混乱，不知道怎么添加苹果与橙子的合计行以及总计行，求解决方案：

Dim lastRow2 As Long
Dim newrow1 As Long, newrow2 As Long, newrow3 As Long, newrow4 as Long

Dim total1 As Long, total2 As Long, total3 As Long, total4 as Long
lastRow2 = DestinationWS.Cells(DestinationWS.Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRow2
        If WS.Cells(i, 2).Value = "apple" Then
            total1 = total1 + WS.Cells(i, 2).Value
            If newrow1 = 0 Then newrow1 = i
        ElseIf WS.Cells(i, 2).Value = "orange" Then
            total2 = total2 + WS.Cells(i, 2).Value
            If newrow2 = 0 Then newrow2 = i
        ElseIf WS.Cells(i, 2).Value = "grape" Then
            total3 = total3 + WS.Cells(i, 2).Value
            If newrow3 = 0 Then newrow3 = i
        End If
   Next i

   If newrow1 > 0 And newrow2 > 0 Then
        WS.Rows(newrow2).Insert Shift:=xlDown
        WS.Cells(newrow2, 1).Value = "total apple"
        WS.Cells(newrow2, 2).Value = total1
   End If
   
   If newrow2 > 0 And newrow3 > 0 Then
        WS.Rows(newrow3).Insert Shift:=xlDown
        WS.Cells(newrow3, 1).Value = "total orange"
        WS.Cells(newrow3, 2).Value = total2
   End If

   If newrow3 > 0 And newrow4 > 0 Then
        WS.Rows(newrow4).Insert Shift:=xlDown
        WS.Cells(newrow4, 1).Value = "total grape"
        WS.Cells(newrow4, 2).Value = total3
   End If

Sub AddTotalRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim appleTotal As Long, orangeTotal As Long, grapeTotal As Long
    Dim appleOrangeTotal As Long, grandTotal As Long
    
    ' 绑定目标工作表，此处用当前活动表，可根据实际修改
    Set ws = ActiveSheet
    
    ' 获取数据区域最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上遍历，避免插入行打乱后续行索引
    i = lastRow
    Do While i >= 2 ' 假设第1行是表头，跳过表头处理
        ' 处理葡萄合计行
        If ws.Cells(i, "A").Value = "grape" And ws.Cells(i + 1, "A").Value <> "葡萄总计" Then
            grapeTotal = WorksheetFunction.SumIf(ws.Range("A:A"), "grape", ws.Range("B:B"))
            ws.Rows(i + 1).Insert Shift:=xlDown
            ws.Cells(i + 1, "A").Value = "葡萄总计"
            ws.Cells(i + 1, "B").Value = grapeTotal
            i = i - 1
        ' 处理橙子合计行，同时插入苹果橙子合计行
        ElseIf ws.Cells(i, "A").Value = "orange" And ws.Cells(i + 1, "A").Value <> "橙子总计" Then
            orangeTotal = WorksheetFunction.SumIf(ws.Range("A:A"), "orange", ws.Range("B:B"))
            ws.Rows(i + 1).Insert Shift:=xlDown
            ws.Cells(i + 1, "A").Value = "橙子总计"
            ws.Cells(i + 1, "B").Value = orangeTotal
            
            ' 仅在橙子合计后插入一次苹果橙子合计
            If ws.Cells(i + 2, "A").Value <> "苹果与橙子总计" Then
                appleTotal = WorksheetFunction.SumIf(ws.Range("A:A"), "apple", ws.Range("B:B"))
                appleOrangeTotal = appleTotal + orangeTotal
                ws.Rows(i + 2).Insert Shift:=xlDown
                ws.Cells(i + 2, "A").Value = "苹果与橙子总计"
                ws.Cells(i + 2, "B").Value = appleOrangeTotal
            End If
            i = i - 1
        ' 处理苹果合计行
        ElseIf ws.Cells(i, "A").Value = "apple" And ws.Cells(i + 1, "A").Value <> "苹果总计" Then
            appleTotal = WorksheetFunction.SumIf(ws.Range("A:A"), "apple", ws.Range("B:B"))
            ws.Rows(i + 1).Insert Shift:=xlDown
            ws.Cells(i + 1, "A").Value = "苹果总计"
            ws.Cells(i + 1, "B").Value = appleTotal
            i = i - 1
        End If
        i = i - 1
    Loop
    
    ' 添加总计行
    grandTotal = appleTotal + orangeTotal + grapeTotal
    ws.Rows(lastRow + 6).Insert Shift:=xlDown ' 因已插入5行合计，偏移6行定位到末尾
    ws.Cells(lastRow + 6, "A").Value = "总计"
    ws.Cells(lastRow + 6, "B").Value = grandTotal
End Sub

1. 从下往上遍历：避免插入行后改变后续行的索引，防止漏处理或重复操作
2. 用SumIf函数计算总和：无需逐行累加，直接根据水果名称匹配求和，简洁高效
3. 插入逻辑：
   • 每个类别最后一行后插入对应合计行，通过判断合计行是否存在防止重复执行
   • 在橙子合计行后插入苹果与橙子的合计行，确保位置符合需求
   • 最后计算所有水果总和，插入总计行
4. 可扩展性：后续新增水果类别时，只需添加对应的判断分支即可

内容的提问来源于stack exchange，提问作者tam