没问题，我来帮你搞定这个Excel VBA需求！下面是完整的实现方案，分排序和分组求和两步来做：

1. 按Section和Rate排序数据 #

首先咱们需要对原始数据按Section（主关键字）和Rate（次关键字）进行升序排序，这样后续的分组求和才能基于连续的相同分组值来执行。

下面是排序的VBA代码片段：

Sub SortData()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    
    ' 设置目标工作表（根据你的实际表名修改）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取数据最后一行（假设Amt列在B列，可根据实际调整）
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 定义数据范围（包含表头，从A1到最后一行的D列）
    Set dataRange = ws.Range("A1:D" & lastRow)
    
    ' 执行排序：先按Section（C列）升序，再按Rate（D列）升序
    With dataRange.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("C1:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=ws.Range("D1:D" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending
        .Header = xlYes ' 第一行是表头
        .Apply
    End With
End Sub

2. 对分组自动求和 #

排序完成后，咱们可以用Excel的Subtotal功能自动给每个Section+Rate的分组添加求和行，同时自动创建分组折叠功能。

下面是分组求和的代码片段：

Sub AddSubtotals()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 先清除已有分类汇总（避免重复添加）
    ws.Cells.RemoveSubtotal
    
    ' 添加分类汇总：按Section和Rate分组，对Amt列（B列）求和
    ws.Range("A1:D" & lastRow).Subtotal _
        GroupBy:=3, ' 按第3列（Section）分组
        Function:=xlSum, ' 求和函数
        TotalList:=Array(2), ' 对第2列（Amt）求和
        Replace:=True, ' 替换已有分类汇总
        PageBreaks:=False, ' 不添加分页符
        SummaryBelowData:=True ' 汇总行在数据下方
    
    ' 注意：因为我们已经按Section+Rate排序，Subtotal会自动识别连续的Rate分组
    ' 如果需要更严格的双分组求和，也可以先按Section分组后，再对每个Section内的Rate分组求和
    ' 不过上面的代码已经能满足你的需求，因为排序后相同Section+Rate的行是连续的
End Sub

把排序和求和整合到一个宏里，一键执行：

Sub SortAndSubtotal()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set dataRange = ws.Range("A1:D" & lastRow)
    
    ' 第一步：排序
    With dataRange.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("C1:C" & lastRow), Order:=xlAscending
        .SortFields.Add Key:=ws.Range("D1:D" & lastRow), Order:=xlAscending
        .Header = xlYes
        .Apply
    End With
    
    ' 第二步：添加分类汇总
    ws.Cells.RemoveSubtotal
    dataRange.Subtotal _
        GroupBy:=3, _
        Function:=xlSum, _
        TotalList:=Array(2), _
        Replace:=True, _
        PageBreaks:=False, _
        SummaryBelowData:=True
    
    ' 可选：自动折叠所有分组，只显示汇总行
    ws.Outline.ShowLevels RowLevels:=2
End Sub

1. 打开你的Excel文件，按下Alt+F11打开VBA编辑器
2. 插入一个新模块（右键点击工作簿 -> 插入 -> 模块）
3. 把上面的完整代码粘贴进去
4. 修改代码中的工作表名（如果你的数据不在Sheet1）和列号（如果你的列位置不同）
5. 回到Excel，按下Alt+F8，选择SortAndSubtotal宏执行

注意：执行前最好先备份你的数据，避免意外情况！

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