Как рассчитать медиану в запросе Access с помощью функции в VBa

Question

Я использую ms Access запрос для расчета MEdian AGe пациентов, сгруппированных по названию клиники с использованием Query. поскольку Access не имеет встроенной медианной функции. Я должен создать его с помощью VBA, Я перепробовал много готовых функций из Интернета ... но ни одна не работала должным образом какие-нибудь предложения для рабочих кодов вокруг? Не могли бы вы помочь мне получить медиану! заранее благодарю.

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/