office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

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

access类似DCount功能的扩展函数-统计不同值的数量

2019-10-11 16:28:00
Allen Browne
翻译
6265

access中,使用 DCount 函数可以统计特定记录集内的总数。但是DCount还有些不足:

1. 内置函数DCount()无法计算不同值的数量;

2. Access中的域聚合函数效率低下。


这里给出一个自定义的Ecount函数,它提供了一个额外的参数,可以计算不同的值

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
                rs.MoveLast
            End If
            ECount = rs.RecordCount     'Return the number of distinct records.
            rs.Close
        End If
    Else
        '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
        rs.Close
    End If

Exit_Handler:
    Set rs = Nothing
    Set db = Nothing
    Exit Function

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



如下图,可以计算字段中不重复的值,如果参数为false,即功能跟Dcount是一样的。


    分享