User Tools

Site Tools


vba:access:functions:group_concat

[VBA][Access] groupConcat() / DConcat()

Eine Aggregationsfumktion um Feldinhalte auf einer Spalte zu gruppieren. Entspricht etwa dem LISTAGG() aus Oracle oder GROUP_CONCAT() as MySQL.

Version 2.0.2 - 31.01.2017

Download udf_groupconcat.bas (V-2.0.2)

Ich brauchte die Funktion GROUP_CONCAT(), wie man sie in MySQL kennt. Kurze Suche im Web hat mir gezeigt, dass man so was am besten über DAO macht. Unter Flatting a Table (Using VBA) wurde ich fündig. Doch irgendwie war die Funktion nicht nach meinem Geschmack. Darum habe ich kurzerhand selber eine Funktion geschrieben.

Die Funktion sollte nicht innerhalb eines SQL auf grössere Datenmengen angewendet werden.
Die Performance wird stark darunter leiden

Definition

Hier werden nur die Funktionsheader gezeigt. Den vollständigen Code ist am Schluss der Seite.

groupConcat()

Text = groupConcat(Feld, Quelle [,Kriterium [,Delimiter [,Sortierung [,Eindeutigkeit]]]])
Public Function groupConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Varian = Null, _
    Optional ByVal iDistinct As Boolean = False _
) As String
  • iExpr Feld das zusammnegeführt werden soll
  • iDomain Quelle (Tabelle, View)
  • iCriteria Where-Bedinung ohne WHERE
  • iDelemiter Delemiter
  • iOrderBy Order By Bedinung
  • iDistinct Werte als DISTINCT behandeln. Sprich doppelte Einträge werden unterdrückt

Der Rückgabelwert ist entweder eine Stringliste oder ein leerer String falls keine Details gefunden wurden. Sollte ein Fehler auftreten, wird #ERR und der Fehlertext zurückgegeben.

DConcat()

DConcat ist ein Alias zu groupConcat. Den habe ich erstellt, um die Funktion den Access-Funktionen DCount, DLookup etc. enzupasen. Einziger Unterschied nebst dem Funktionsnamen: iDistinct ist Default auf True.

Text = DConcat(Feld, Quelle [,Kriterium [,Delimiter [,Sortierung [,Eindeutigkeit]]]])
Public Function DConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Variant = Null, _
    Optional ByVal iDistinct As Boolean = True _
) As String

Anwendungsbeispiele

VBA-Beispiel

Eine einfache Abfrage auf eine Tabelle

'Enfache Abfrage. Duplikate werden nicht unterdrückt
debug.print groupConcat("set_name","my_table"," group_id=12")
Montags-Report, TEST, TEST
 
'oder mit DConcat(). Duplikate werden standartmässig unterdrückt
debug.print DConcat("set_name","my_table"," group_id=12")
Montags-Report, TEST
 
'Die Unterdrückung kann auch aufgehoben werden. Zudem der Delimiter und die Sortierung angepasst
debug.print DConcat("set_name","my_table"," group_id=12", "-", "mein_datum", false)
TEST-Montags-Report-TEST

SQL-Beispiel

Die Funktion ist prädestiniert um innerhalb eines SQL-Statements anzuwenden. Damit wird die Funktion auf jede Zeile angewendet.

SELECT
    t.group_id,
    DCONCAT("set_name","my_table","group_id=" & t.group_id, , "mein_datum")
FROM
    my_table AS t
GROUP BY
    t.group_id

In einem Reportfooter

Man kann die Funktion auch in einem berechneten Textfeld eines Report-Fusses (oder Kopf) verwenden. Dabei kann man die Quelle und den Filter des Reports automatisch übernhemen

=groupConcat("name";[RecordSource];IIf([FilterOn];[Filter];""))

Ebenfalls in einem Gruppenfuss. Der Filter muss um das Gruppierungsfeld erweitertwerden. In diesem Beispiel das Feld my_group_field.

=groupConcat("name";[RecordSource];IIf([FilterOn];[Filter];"TRUE") & " AND [my_group_field] = " &  [my_group_field])

Beispele zu den Feldtypen

Die meisten Felder sind normale SQL-String. Sprich es gelten die folgenden Regelen:

  • Feldnamen dürfen nur Zahlen und Buchstaben enthalten. Ansonsten müssen sie in [] geschrieben werden
  • String müssen als SQL-String erfasst werden. Also mit ' oder “ als Begrenzungszeichen.
  • Datum müssen im SQL-Format erfasst werden: #MM/DD/YYYY#, #HH:NN:SS# bzw. #MM/DD/YYYY HH:NN:SS#
'Felder mit Leerzeichen und Sonderzeichen
groupConcat("[Mein Feld]","[Meine Tabelle]","[Filter Code]='Zürich'", ".", "[Mein Soriterfeld Nr.3]")
 
'Filterwert als Datum
groupConcat("MeinFeld","MeineTabelle","[Von Datum]>=#11/01/2015#")
groupConcat("MeinFeld","MeineTabelle","[Von Datum]>=" & Format([meinDatumsFeld], "\#mm\/dd\/yyyy\#"))
 
'Filterwert als String mit '
groupConcat("MeinFeld","MeineTabelle","FilterCode>='abc'")
groupConcat("MeinFeld","MeineTabelle","FilterCode>='" & [filerFeld] & "'")
'oder mit ""
groupConcat("MeinFeld","MeineTabelle","FilterCode>=""abc""")
groupConcat("MeinFeld","MeineTabelle","FilterCode>=""" & [filerFeld] & """")
 
'Filter ist ein Boolean
groupConcat("MeinFeld","MeineTabelle","FilterCode=True")
groupConcat("MeinFeld","MeineTabelle","FilterCode=" & [meinBooleanFeld])
 
'Filter ist eine Zahl
groupConcat("MeinFeld","MeineTabelle","FilterCode>=123")
groupConcat("MeinFeld","MeineTabelle","FilterCode>=" & [meinZahlenFeld])

Code

Der Code ist zum Importieren gedacht. Wenn du ihn einfach in ein neues Modul kopierst, musst du den Header (Attribute-Zeilen) löschen.

udf_groupconcat.bas
Attribute VB_Name = "udf_groupConcat"
'-------------------------------------------------------------------------------
'File         : udf_groupConcat.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/access/functions/group_concat
'Environment  : VBA 2010 +
'Version      : 2.0.2
'Name         : groupConcat
'Author       : Stefan Erb (ERS)
'History      : 00.00.0000 - ERS - Creation
'               ..
'               20.11.2015 - ERS - Recordset mit einem with als temporärer Recordset
'               29.03.2016 - ERS - DConcat() hinzugefügt
'               28.04.2016 - ERS - Auf ADODB umgestellt
'               23.12.2016 - ERS - Fehler behoben. GetString() kannte nicht mit einem leeren Delimiter umgehen
'               31.01.2017 - ERS - Fehler behoben. adClipString war nicht immer bekannt. Ist jetzt eine Konstante
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * Alias zu groupConcat(). Passt von der Namensgebung zu den Access-Funktionen DSum, DCount etc.
' * Im Gegensatz zu groupConcat() ist iDistinct standardmässig auf True
' */
Public Function DConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Variant = Null, _
    Optional ByVal iDistinct As Boolean = True _
) As String
    DConcat = groupConcat(iExpr, iDomain, iCriteria, iDelimiter, iOrderBy, iDistinct)
End Function
 
'/**
' * Simuliert ein GROUP_CONCAT()
' * http://blogannath.blogspot.ch/2011/01/microsoft-access-tips-tricks-flattening_28.html
' * String = groupConcat(expr, domain [,criteria [,Delimiter [,OrderBy [,Distinct]]]])
' * @param  String      Feld das zusammnegeführt werden soll
' * @param  String      Quelle (Tabelle, View)
' * @param  String      Where-Bedinung ohne WHERE
' * @param  String      Delimiter
' * @param  String      Order By Bedinung. Wenn nichts angegebn ist, wird nach iExpr aufsteigend sortiert
' * @param  Boolean     Werte als DISTINCT behandeln
' * @return String
' */
Public Function groupConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Variant = Null, _
    Optional ByVal iDistinct As Boolean = False _
) As String
    Const C_EMPTY_DELIMITER = "\u0020"
    Const adClipString = 2
On Error GoTo Err_Handler
 
    'Create SQL String
    Dim sql As String: sql = "SELECT " & IIf(iDistinct, "DISTINCT ", "") & iExpr & " AS item FROM " & iDomain
    If Not IsNull(iCriteria) Then sql = sql & " WHERE " & CStr(iCriteria)
    sql = sql & " ORDER BY " & NZ(iOrderBy, iExpr & " ASC")
 
    Dim delimiter As String: delimiter = IIf(iDelimiter = Empty, C_EMPTY_DELIMITER, iDelimiter)
    'Get the Delimited String
    groupConcat = CurrentProject.connection.execute(sql).GetString(adClipString, -1, delimiter, delimiter)
    'Remove the Delimiter at the End of the String: '1000, 1144, 3000, ' -> '1000, 1144, 3000'
    If groupConcat Like "*" & delimiter Then groupConcat = Left(groupConcat, Len(groupConcat) - Len(delimiter))
    If iDelimiter = Empty Then groupConcat = replace(groupConcat, C_EMPTY_DELIMITER, iDelimiter)
 
Exit_Handler:
On Error Resume Next
    Exit Function
Err_Handler:
    groupConcat = "#ERR: " & Err.DESCRIPTION & " (" & sql & ")"
    Resume Exit_Handler
    Resume
End Function
 
 
vba/access/functions/group_concat.txt · Last modified: 31.01.2017 12:08:13 by yaslaw