DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
=ecount("[alan ismi]";"[tablo ismi]";"[alan ismi]<>' ' ";True)