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

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


2019-10-11 16:28:00
Allen Browne

access中,使用 DCount 函數可以統計特定記録集內的總數。但是DCount還有些不足:

1. 內置函數DCount()無法計祘不衕值的數量;

2. Access中的域聚閤函數效率低下。


Public Function ECount(Expr As String, Domain As String, Optional Criteria As String, Optional bCountDistinct As Boolean) As Variant
On Error GoTo Err_Handler
    'Purpose:   Enhanced DCount() function, with the ability to count distinct.
    'Return:    Number of records. Null on error.
    'Arguments: Expr           = name of the field to count. Use square brackets if the name contains a space.
    '           Domain         = name of the table or query.
    '           Criteria       = any restrictions. Can omit.
    '           bCountDistinct = True to return the number of distinct values in the field. Omit for normal count.
    'Notes:     Nulls are excluded (whether distinct count or not.)
    '           Use "*" for Expr if you want to count the nulls too.
    '           You cannot use "*" if bCountDistinct is True.
    'Examples:  Number of customers who have a region: ECount("Region", "Customers")
    '           Number of customers who have no region: ECount("*", "Customers", "Region Is Null")
    '           Number of distinct regions: ECount("Region", "Customers", ,True)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSql As String

    'Initialize to return Null on error.
    ECount = Null
    Set db = DBEngine(0)(0)

    If bCountDistinct Then
        'Count distinct values.
        If Expr <> "*" Then             'Cannot count distinct with the wildcard.
            strSql = "SELECT " & Expr & " FROM " & Domain & " WHERE (" & Expr & " Is Not Null)"
            If Criteria <> vbNullString Then
                strSql = strSql & " AND (" & Criteria & ")"
            End If
            strSql = strSql & " GROUP BY " & Expr & ";"
            Set rs = db.OpenRecordset(strSql)
            If rs.RecordCount > 0& Then
            End If
            ECount = rs.RecordCount     'Return the number of distinct records.
        End If
        'Normal count.
        strSql = "SELECT Count(" & Expr & ") AS TheCount FROM " & Domain
        If Criteria <> vbNullString Then
            strSql = strSql & " WHERE " & Criteria
        End If
        Set rs = db.OpenRecordset(strSql)
        If rs.RecordCount > 0& Then
            ECount = rs!TheCount        'Return the count.
        End If
    End If

    Set rs = Nothing
    Set db = Nothing
    Exit Function

    MsgBox Err.Description, vbExclamation, "ECount Error " & Err.Number
    Resume Exit_Handler
End Function