vba - 如何使用 VBa 中的函数计算 Access 查询中的中位数

Question

我正在使用 ms Access 查询来计算使用查询按诊所名称分组的患者的中位年龄。因为 Access 没有内置的 Median 函数。我必须使用 VBA 创建它，我尝试了许多来自 web 的现成函数。但没有一个能正常工作。关于工作代码的任何建议？你能帮我得到中位数吗？提前谢谢你。

标签： vbams-access

Answer 1

这是一个很好的功能，也得到了很好的评论：

Public Function acbDMedian( _
 ByVal strField As String, ByVal strDomain As String, _
 Optional ByVal strCriteria As String) As Variant

    ' Purpose:
    '     To calculate the median value
    '     for a field in a table or query.
    ' In:
    '     strField: The field
    '     strDomain: The table or query
    '     strCriteria: An optional WHERE clause to
    '                  apply to the table or query
    ' Out:
    '     Return value: The median, if successful;
    '                   otherwise, an error value

    Dim db As DAO.Database
    Dim rstDomain As DAO.Recordset
    Dim strSQL As String
    Dim varMedian As Variant
    Dim intFieldType As Integer
    Dim intRecords As Integer

    Const acbcErrAppTypeError = 3169

    On Error GoTo HandleErr

    Set db = CurrentDb( )

    ' Initialize the return value.
    varMedian = Null

    ' Build a SQL string for the recordset.
    strSQL = "SELECT " & strField
    strSQL = strSQL & " FROM " & strDomain

    ' Use a WHERE clause only if one is passed in.
    If Len(strCriteria) > 0 Then
        strSQL = strSQL & " WHERE " & strCriteria
    End If

    strSQL = strSQL & " ORDER BY " & strField

    Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot)

    ' Check the data type of the median field.
    intFieldType = rstDomain.Fields(strField).Type
    Select Case intFieldType
    Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbDate
        ' Numeric field.
        If Not rstDomain.EOF Then
            rstDomain.MoveLast
            intRecords = rstDomain.RecordCount
            ' Start from the first record.
            rstDomain.MoveFirst

            If (intRecords Mod 2) = 0 Then
                ' Even number of records. No middle record, so move
                ' to the record right before the middle.
                rstDomain.Move ((intRecords \ 2) - 1)
                varMedian = rstDomain.Fields(strField)
                ' Now move to the next record, the one right after
                ' the middle.
                rstDomain.MoveNext
                ' Average the two values.
                varMedian = (varMedian + rstDomain.Fields(strField)) / 2
                ' Make sure you return a date, even when averaging
                ' two dates.
                If intFieldType = dbDate And Not IsNull(varMedian) Then
                    varMedian = CDate(varMedian)
                End If
            Else
                ' Odd number of records. Move to the middle record
                ' and return its value.
                rstDomain.Move ((intRecords \ 2))
                varMedian = rstDomain.Fields(strField)
            End If
        Else
            ' No records; return Null.
            varMedian = Null
        End If
    Case Else
        ' Nonnumeric field; raise an app error.
        Err.Raise acbcErrAppTypeError
    End Select

    acbDMedian = varMedian

ExitHere:
    On Error Resume Next
    rstDomain.Close
    Set rstDomain = Nothing
    Exit Function

HandleErr:
    ' Return an error value.
    acbDMedian = CVErr(Err)
    Resume ExitHere
End Function

来源：http ://etutorials.org/Microsoft+Products/access/Chapter+6.+Data/Recipe+6.4+Find+the+Median+Value+for+a+Field/