Access VBA实现按两列GROUP BY分组计算数据集中位数

需求说明 #

需要对数据表按typeA、typeB两列分组后，计算每组total字段的中位数，示例表结构与数据如下：

原代码问题与修改方案 #

原代码仅支持单列分组，且存在两处逻辑错误，修改后的完整代码如下：

Function fMedian(SQLOrTable, GroupFieldName, GroupFieldValue, GroupFieldName2, GroupFieldValue2, MedianFieldName)
    DoCmd.SetWarnings False
    ' 补充变量声明，避免隐式变量错误
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs As DAO.Recordset
    Dim varMedian1 As Variant
    
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset(SQLOrTable, dbOpenDynaset)
    
    ' 处理第一个分组字段的值转义
    If IsDate(GroupFieldValue) Then
        GroupFieldValue = "#" & GroupFieldValue & "#"
    ElseIf Not IsNumeric(GroupFieldValue) Then
        GroupFieldValue = "'" & Replace(GroupFieldValue, "'", "''") & "'"
    End If
    
    ' 修复：第二个分组字段的类型判断原逻辑写错了判断对象
    If IsDate(GroupFieldValue2) Then
        GroupFieldValue2 = "#" & GroupFieldValue2 & "#"
    ElseIf Not IsNumeric(GroupFieldValue2) Then
        GroupFieldValue2 = "'" & Replace(GroupFieldValue2, "'", "''") & "'"
    End If
    
    ' 核心修改：Filter拼接两个分组条件，实现双列过滤
    rs1.Filter = GroupFieldName & "=" & GroupFieldValue & " AND " & GroupFieldName2 & "=" & GroupFieldValue2
    rs1.Sort = MedianFieldName
    
    Set rs = rs1.OpenRecordset()
    ' 处理空组情况避免报错
    If rs.RecordCount = 0 Then
        fMedian = Null
        GoTo Cleanup
    End If
    rs.Move (rs.RecordCount \ 2) ' 用整除避免小数位置
    
    If rs.RecordCount Mod 2 = 0 Then
        varMedian1 = rs.Fields(MedianFieldName)
        rs.MoveNext
        ' 修复：偶数个值的中位数计算逻辑，原写法运算顺序错误
        fMedian = (varMedian1 + rs.Fields(MedianFieldName)) / 2
    Else
        fMedian = rs.Fields(MedianFieldName)
    End If
    
    ' 按需添加该行适配外部调用
    medianVBA = fMedian
    
Cleanup:
    ' 释放资源避免内存泄漏
    rs.Close
    rs1.Close
    Set rs = Nothing
    Set rs1 = Nothing
    Set db = Nothing
    DoCmd.SetWarnings True
End Function

使用方法 #

直接调用函数即可返回对应分组的中位数，示例调用：
fMedian("你的表名", "typeA", 1, "typeB", 2, "total")
以上调用将返回typeA=1且typeB=2分组的total中位数，对应示例数据结果为19。

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