VBA Tipp: Distinct Count

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Ich möchte Datensätze ohne Duplikate zählen. Mit DCount() klappt das aber nicht. Die beiden folgenden Funktionen (Access 97 braucht einen leicht veränderten Code) lassen sich genauso wie DCount() einsetzen, zählen Duplikate aber nur einmal.

Lösung ab Access 2000

Public Function DistinctCount(strFeld As String, _
              strTab As String, Optional Kriterien)
 
'Verweis auf DAO muß gesetzt sein
'S. dazu FAQ 7.11 auf www.donkarl.com
 
'Anwendung
'  im Direktfenster:
'    ?DistinctCount("FeldName","Tabellenname","Kriterium nach SQL-Art")
'  als Steuerelementinhalt:
'    =DistinctCount("FeldName";"Tabellenname","Kriterium nach SQL-Art")
 
Dim strSQL As String
 
strSQL = "SELECT COUNT(*) FROM (" _
       & "SELECT COUNT(*) AS B FROM " & strTab
 
If Not IsMissing(Kriterien) And Not IsNull(Kriterien) _
   Then strSQL = strSQL & " WHERE " & Kriterien
 
strSQL = strSQL & " GROUP BY " & strFeld & ")"
 
'nur für Testzwecke folgende Zeile aktivieren:
'Debug.Print strSQL
 
DistinctCount = DBEngine(0)(0).OpenRecordset( _
                strSQL, dbOpenSnapshot)(0)
 
End Function

Lösung für Access 97

Die Funktion Distinctcount erstellt anscheinend einen SQL-String, mit dem Access 97 nicht umgehen kann. Deshalb hier ein leicht veränderter Ansatz:

Function DistinctCountNeu(strFeld As String, strTab As String, Optional Kriterien)
 
Dim rs As DAO.Recordset
Dim strSQL As String
Dim uebergabe As Long
 
strSQL = "SELECT COUNT(*) FROM " & strTab
 
If Not IsMissing(Kriterien) And Not IsNull(Kriterien) _
   Then strSQL = strSQL & " WHERE " & Kriterien
 
strSQL = strSQL & " GROUP BY " & strFeld
 
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
If Not rs.EOF Then
  rs.MoveLast
  uebergabe = rs.RecordCount
End If
 
rs.Close
Set rs = Nothing
 
DistinctCountNeu = uebergabe
 
End Function