Access VBA：在两列上使用 GROUP BY 计算数据的中值

Question

我正在尝试找到一种方法来计算访问中数据集的中位数，该数据集按两列分组，typeA, typeB。

这是 table 的示例：

ID（自动编号）	typeA（大号）	B型（大号）	总计（大数）
1	1	1	15
2	2	1	15
3	1	1	45
4	2	1	44
5	1	2	19
6	1	2	4
7	1	2	34
8	2	2	19
9	2	2	18

使用 Access 2016

目前我正在使用以下代码片段：

Function fMedian(SQLOrTable, GroupFieldName, GroupFieldValue, GroupFieldName2, GroupFieldValue2, MedianFieldName)
DoCmd.SetWarnings False

Dim rs As DAO.Recordset

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(GroupFieldValue) Then
    GroupFieldValue2 = "'" & Replace(GroupFieldValue2, "'", "''") & "'"
End If

rs1.Filter = GroupFieldName & "=" & GroupFieldValue
rs1.Sort = MedianFieldName

Set rs = rs1.OpenRecordset()
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

End Function

就目前而言，这非常适合按一列分组，但我不知道如何让它按 typeA 和 typeB 分组。我已经通过编辑 rs1.filter 行但无济于事。

任何有关代码的帮助或更好的方法将不胜感激。

谢谢！

注意：使用下面的冻糕解决方案解决了。在函数结束前添加行 medianVBA = fmedian。

Answer 1

请原谅我在这里采取完全不同的方法...

假设您有一个名为 Table1 的 Table，字段为 Field1。要找到 Field1 的中位数，SQL 查询将如下所示：

SELECT TOP 1 
    ((SELECT MAX(B.Field1) AS Field1 FROM 
        (SELECT TOP 50 PERCENT A.Field1 FROM Table1 A)
     B) +
    (SELECT MIN(D.Field1) AS Field1 FROM 
        (SELECT TOP 50 PERCENT C.Field1 FROM Table1 C ORDER BY C.Field1 DESC) 
    D))
/2 AS MEDIAN FROM Table1

（上面拆分出来方便阅读，我只写了两行）

从那里你所要做的就是编写 vba 使其动态 - 将 'Table1' 替换为你的变量 SQLorTable 并将 Field1 替换为要查找的字段

的中位数

Answer 2

考虑扩展@Fionnuala 的伟大 answer，通过容纳不限成员名额的分组变量来计算 MS Access 中的中位数。

VBA （下面保存在Access项目的标准模块中）

代码为 DAO 记录集调用构建一个动态 SQL 字符串，以便稍后进行中值计算。具有 0-2 条记录的分组和分组的空值需要特殊处理。

Public Function MedianVBA(ParamArray Arr() As Variant) As Double
On Error GoTo ErrHandle
    Dim N As Long
    Dim tblName As String, numCol As String, grpVals As String
    Dim strSQL As String
    Dim db As DAO.Database, rs As DAO.Recordset
    Dim varMedian As Double, fMedian As Double
    
    'BUILD DYNAMIC SQL
    tblName = Arr(0)
    numCol = Arr(1)
    grpVals = " WHERE " & numCol & " IS NOT NULL "
        
    For N = 2 To UBound(Arr) Step 2
        If Arr(N + 1) = "" Or IsNull(Arr(N + 1)) Then
            grpVals = grpVals & " AND " & Arr(N) & " IS NULL"
        ElseIf IsDate(Arr(N + 1)) Then
            grpVals = grpVals & " AND " & Arr(N) & " = #" & Arr(N + 1) & "#"
        Else
            grpVals = grpVals & " AND CStr(" & Arr(N) & ") = '" & Arr(N + 1) & "'"
        End If
    Next N

    strSQL = "SELECT " & numCol _
              & " FROM " & tblName _
              & grpVals _
              & " ORDER BY " & numCol
  
    'CALCULATE MEDIAN
    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    
    If rs.RecordCount = 0 Then
        MedianAcc = fMedian
        GoTo ExitHandle
    ElseIf rs.RecordCount = 1 Then
        MedianAcc = rs.Fields(numCol)
        GoTo ExitHandle
    End If
    
    rs.Move (rs.RecordCount / 2)
    rs.MovePrevious

    If rs.RecordCount Mod 2 = 0 Then
        varMedian = rs.Fields(numCol)
        If rs.RecordCount = 2 Then
            rs.MoveLast
        Else
            rs.MoveNext
        End If
        fMedian = (varMedian + rs.Fields(numCol)) / 2
    Else
        fMedian = rs.Fields(numCol)
    End If

    rs.Close
    MedianAcc = fMedian
  
ExitHandle:
    Set rs = Nothing: Set db = Nothing
    Exit Function
    
ErrHandle:
    MsgBox Err.Number & ": " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Function

请注意，上面的 VBA 函数使用 ParamArray，其中第一个参数需要源 table，第二列需要数字列，其余的对于组列是开放式的名称和值对。通话签名如下：

=MedianAcc("table_name", 
           "numeric_col", 
           "group1_column", "group1_value",
           "group2_column", "group2_value", 
           ...)

SQL （调用上面VBA函数的存储查询）

下面运行一组和两组中值计算。

SELECT t.typeA, t.typeB
       , MedianVBA('[myTable]', '[total]', '[typeA]', t.typeA) AS MedianGrp1, 
       , MedianVBA('[myTable]', '[total]', '[typeA]', t.typeA, '[typeB]', t.typeB) AS MedianGrp2
FROM myTable t
GROUP BY t.typeA, t.typeB

Access VBA：在两列上使用 GROUP BY 计算数据的中值

Access VBA: Calculating Median on data using GROUP BY on two columns

sql

vba

ms-access

group-by

median