Welcome toVigges Developer Community-Open, Learning,Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.3k views
in Technique[技术] by (71.8m points)

how to calculate median in Access query using function in VBa

I'm using ms Access query to calculate the MEdian AGe of Patients grouped by Clinic name using Query. since Access doesn't have build-in Median function. I have to create it using VBA, I tried many ready functions from web.. but none worked properly. any suggestions for working codes around? could u plz help me to get the median! thank u in advance.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

This is a good function also pretty well commented:

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

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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to Vigges Developer Community for programmer and developer-Open, Learning and Share
...