office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

access類似DAvg功能的擴展函數-求多箇排序數值的平均值

2019-10-14 15:30:00
Allen Browne
翻譯
4339
Access內置的DAvg()函數可以選擇指定條件,穫取錶中字段的平均值

下麵分享一箇名爲EAvg()函數,該函數是DAvg函數的擴展,可以從該字段中穫取TOP(或百分比)的平均值。 甚至可以指定其他字段進行排序


Public Function EAvg(strExpr As String, strDomain As String, Optional strCriteria As String, _
    Optional dblTop As Double, Optional strOrderBy As String) As Variant
On Error GoTo Err_Error
    'Purpose:   Extended replacement for DAvg().
    'Author:    Allen Browne (allen@allenbrowne.com), November 2006.
    'Requires:  Access 2000 and later.
    'Return:    Average of the field in the domain. Null on error.
    'Arguments: strExpr     = the field name to average.
    '           strDomain   = the table or query to use.
    '           strCriteria = WHERE clause limiting the records.
    '           dblTop      = TOP number of records to average. Ignored if zero or negative.
    '                             Treated as a percent if less than 1.
    '           strOrderBy  = ORDER BY clause.
    'Note:      The ORDER BY clause defaults to the expression field DESC if none is provided.
    '               However, if there is a tie, Access returns more than the TOP number specified,
    '               unless you include the primary key in the ORDER BY clause. See example below.
    'Example:   Return the average of the 4 highest quantities in tblInvoiceDetail:
    '               EAvg("Quantity", "tblInvoiceDetail",,4, "Quantity DESC, InvoiceDetailID")
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim lngTopAsPercent As Long

    EAvg = Null     'Initialize to null.

    lngTopAsPercent = 100# * dblTop
    If lngTopAsPercent > 0& Then
        'There is a TOP predicate
        If lngTopAsPercent < 100& Then 'Less than 1, so treat as percent. strSql = "SELECT Avg(" & strExpr & ") AS TheAverage " & vbCrLf & _ "FROM (SELECT TOP " & lngTopAsPercent & " PERCENT " & strExpr Else 'More than 1, so treat as count. strSql = "SELECT Avg(" & strExpr & ") AS TheAverage " & vbCrLf & _ "FROM (SELECT TOP " & CLng(dblTop) & " " & strExpr End If strSql = strSql & " " & vbCrLf & " FROM " & strDomain & " " & vbCrLf & _ " WHERE (" & strExpr & " Is Not Null)" If strCriteria <> vbNullString Then
            strSql = strSql & vbCrLf & " AND (" & strCriteria & ") "
        End If
        If strOrderBy <> vbNullString Then
            strSql = strSql & vbCrLf & " ORDER BY " & strOrderBy & ") AS MySubquery;"
        Else
            strSql = strSql & vbCrLf & " ORDER BY " & strExpr & " DESC) AS MySubquery;"
        End If
    Else
        'There is no TOP predicate (so we also ignore any ORDER BY.)
        strSql = "SELECT Avg(" & strExpr & ") AS TheAverage " & vbCrLf & _
            "FROM " & strDomain & " " & vbCrLf & "WHERE (" & strExpr & " Is Not Null)"
        If strCriteria <> vbNullString Then
            strSql = strSql & vbCrLf & " AND (" & strCriteria & ")"
        End If
        strSql = strSql & ";"
    End If

    Set rs = DBEngine(0)(0).OpenRecordset(strSql)
    If rs.RecordCount > 0& Then
        EAvg = rs!TheAverage
    End If
    rs.Close

Exit_Handler:
    Set rs = Nothing
    Exit Function

Err_Error:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , "EAvg()"
    Resume Exit_Handler
End Function



Eavg函數排序蔘數默認是降序,取前麵2位後再求平均值,如下圖。

    分享