VBA中如何对已获取的ADODB.Recordset直接执行聚合查询

以下两种方案都不需要再次请求原数据库，可直接基于已获取的本地Recordset或已导出的Sheet1数据完成计算：

方案1：字典遍历实现（无额外依赖，兼容性最好） #

逻辑：遍历本地Recordset的所有行，以分组字段拼接值作为字典键，值存储对应分组的累加指标，遍历完成后输出结果并排序。

Sub AggregateByDict()
    ' 需提前引用Microsoft Scripting Runtime，或用CreateObject创建字典
    Dim groupDict As Object
    Set groupDict = CreateObject("Scripting.Dictionary")
    Dim groupKey As String
    Dim sumCol1 As Double, sumCol2 As Double, rowCnt As Long
    
    ' 空记录集直接退出
    If rs.BOF And rs.EOF Then Exit Sub
    rs.MoveFirst
    
    Do While Not rs.EOF
        ' 按需求拼接分组键，示例为group by 记录集第1、2列（ADODB字段索引从0开始）
        groupKey = rs.Fields(0).Value & "|" & rs.Fields(1).Value
        If groupDict.Exists(groupKey) Then
            ' 已有分组累加指标，空值做0处理
            groupDict(groupKey)(0) = groupDict(groupKey)(0) + IIf(IsNull(rs.Fields("col1").Value), 0, rs.Fields("col1").Value)
            groupDict(groupKey)(1) = groupDict(groupKey)(1) + 1
            groupDict(groupKey)(2) = groupDict(groupKey)(2) + IIf(IsNull(rs.Fields("col2").Value), 0, rs.Fields("col2").Value)
        Else
            ' 新增分组初始化指标
            sumCol1 = IIf(IsNull(rs.Fields("col1").Value), 0, rs.Fields("col1").Value)
            rowCnt = 1
            sumCol2 = IIf(IsNull(rs.Fields("col2").Value), 0, rs.Fields("col2").Value)
            groupDict.Add groupKey, Array(sumCol1, rowCnt, sumCol2)
        End If
        rs.MoveNext
    Loop
    
    ' 结果输出到Sheet2
    Dim outputRow As Long: outputRow = 1
    ' 写表头
    Sheet2.Cells(outputRow, 1) = "sum(col1)"
    Sheet2.Cells(outputRow, 2) = "count(*)"
    Sheet2.Cells(outputRow, 3) = "sum(col2)"
    outputRow = outputRow + 1
    
    ' 遍历字典输出数据
    Dim arr As Variant
    For Each arr In groupDict.Items
        Sheet2.Cells(outputRow, 1) = arr(0)
        Sheet2.Cells(outputRow, 2) = arr(1)
        Sheet2.Cells(outputRow, 3) = arr(2)
        outputRow = outputRow + 1
    Next
    
    ' 按分组字段排序
    Sheet2.UsedRange.Sort Key1:=Sheet2.Columns(1), Order1:=xlAscending, Key2:=Sheet2.Columns(2), Order2:=xlAscending, Header:=xlYes
End Sub

注意事项：

• 若分组字段可能包含|字符，可替换为其他不会出现的分隔符拼接分组键
• 字段名和索引需和你实际的Recordset结构匹配

方案2：查询Sheet1数据实现（代码量最少，逻辑和原SQL一致） #

因你已将Recordset导出到Sheet1，可直接用ADODB连接当前Excel文件查询Sheet1的区域，不用访问原数据库：

Sub AggregateByQuerySheet()
    Dim xlConn As New ADODB.Connection
    Dim aggRs As New ADODB.Recordset
    
    ' 连接当前工作簿
    xlConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    ' 执行聚合SQL，[Sheet1$]为数据所在工作表，GROUP BY后替换为实际分组列的表头名
    aggRs.Open "SELECT SUM(col1), COUNT(*), SUM(col2) FROM [Sheet1$] GROUP BY 分组列1,分组列2 ORDER BY 分组列1,分组列2", xlConn
    
    ' 直接输出结果到Sheet2 A1单元格
    Sheet2.Range("A1").CopyFromRecordset aggRs
    
    ' 释放资源
    aggRs.Close
    xlConn.Close
    Set aggRs = Nothing
    Set xlConn = Nothing
End Sub

注意事项：

• 若Sheet1数据没有表头，需要将连接字符串里的HDR=YES改为HDR=NO，SQL里用F1、F2指代列
• 32位和64位Excel都支持该连接串，无需额外配置

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