MS Access | Решение задачи скручивания данных колонки в строку в заданной группировке

Использование в SELECT_запросе:

UniqConcatRelated("FIELD_NAME_1","TABLE_NAME","","SORT_FIELD_NAME","PARAM",GROUP_FIELD_NAME)

Где

первый параметр: FIELD_NAME_1 – поле, значения которого требуется получить в строке (см. в функции переменную strField)

второй параметр: TABLE_NAME – источник данных (см. в функции переменную strTable)

третий параметр: условие WHERE (см. в функции переменную strWhere), если нет, то ""

четвёртый параметр: SORT_FIELD_NAME – поле, по которому сортировать (см. в функции переменную strOrderBy)

пятый параметр: PARAM – наименование параметра в запросе (если есть)

шестой параметр: GROUP_FIELD_NAME – по какому полю группировать

Другой вариант:

UniqConcatRelated("FIELD_NAME_1";"TABLE_NAME_1";"FIELD_NAME_2= """ & [TABLE_NAME_2].[FIELD_NAME_2] & """")

Ещё вариант:

UniqConcatRelated("trim(FIELD_NAME_1)";" TABLE_NAME_1";"FIELD_NAME_2 = """ & [TABLE_NAME_2].[FIELD_NAME_2] & """";"SORT_FIELD_NAME")

и так далее

'http://allenbrowne.com/func-concat.html

Public Function AllConcatRelated(strField As String, _

strTable As String, _

Optional strWhere As String, _

Optional strOrderBy As String, _

Optional strSeparator = "; ") As Variant

On Error GoTo Err_Handler

'Purpose: Generate a concatenated string of related records.

'Return: String variant, or Null if no matches.

'Arguments: strField = name of field to get results from and concatenate.

' strTable = name of a table or query.

' strWhere = WHERE clause to choose the right values.

' strOrderBy = ORDER BY clause, for sorting the values.

' strSeparator = characters to use between the concatenated values.

'Notes: 1. Use square brackets around field/table names with spaces or odd characters.

' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.

' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.

' 4. Returning more than 255 characters to a recordset triggers this Access bug:

' http://allenbrowne.com/bug-16.html

Dim rs As DAO.Recordset 'Related records

Dim rsMV As DAO.Recordset 'Multi-valued field recordset

Dim strSql As String 'SQL statement

Dim strOut As String 'Output string to concatenate to.

Dim lngLen As Long 'Length of string.

Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.

'Initialize to Null

ConcatRelated = Null

'Build SQL string, and get the records.

strSql = "SELECT " & strField & " FROM " & strTable

If strWhere <> vbNullString Then

strSql = strSql & " WHERE " & strWhere

End If

If strOrderBy <> vbNullString Then

strSql = strSql & " ORDER BY " & strOrderBy

End If

Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)

'Determine if the requested field is multi-valued (Type is above 100.)

bIsMultiValue = (rs(0).Type > 100)

'Loop through the matching records

Do While Not rs.EOF

If bIsMultiValue Then

'For multi-valued field, loop through the values

Set rsMV = rs(0).Value

Do While Not rsMV.EOF

If Not IsNull(rsMV(0)) Then

strOut = strOut & rsMV(0) & strSeparator

End If

rsMV.MoveNext

Loop

Set rsMV = Nothing

ElseIf Not IsNull(rs(0)) Then

strOut = strOut & rs(0) & strSeparator

End If

rs.MoveNext

Loop

rs.Close

'Return the string without the trailing separator.

lngLen = Len(strOut) - Len(strSeparator)

If lngLen > 0 Then

ConcatRelated = Left(strOut, lngLen)

End If

Exit_Handler:

'Clean up

Set rsMV = Nothing

Set rs = Nothing

Exit Function

Err_Handler:

MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "ConcatRelated()"

Resume Exit_Handler

End Function

Sub remember(ByRef dict As Dictionary, ByRef key As Object)

If Not IsNull(key) Then

Dim s As String

s = "" & key

If Not dict.Exists(s) Then

dict.Add s, False

End If

End Sub

' based on http://allenbrowne.com/func-concat.html

Public Function UniqConcatRelated(strField As String, _

strTable As String, _

Optional strWhere As String, _

Optional strOrderBy As String, _

Optional strParamName As String, _

Optional strParamValue As String, _

Optional strSeparator = "; ") As Variant

'On Error GoTo Err_Handler

'Purpose: Generate a concatenated string of related records.

'Return: String variant, or Null if no matches.

'Arguments: strField = name of field to get results from and concatenate.

' strTable = name of a table or query.

' strWhere = WHERE clause to choose the right values.

' strOrderBy = ORDER BY clause, for sorting the values.

' strSeparator = characters to use between the concatenated values.

'Notes: 1. Use square brackets around field/table names with spaces or odd characters.

' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.

' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.

' 4. Returning more than 255 characters to a recordset triggers this Access bug:

' http://allenbrowne.com/bug-16.html

Dim rs As DAO.Recordset 'Related records

Dim rsMV As DAO.Recordset 'Multi-valued field recordset

Dim strSql As String 'SQL statement

Dim dictOut As New Dictionary 'Accumulated info, keys

Dim lngLen As Long 'Length of string.

Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.

'Initialize to Null

UniqConcatRelated = Null

'Build SQL string, and get the records.

strSql = "SELECT " & strField & " FROM " & strTable

If strWhere <> vbNullString Then

strSql = strSql & " WHERE " & strWhere

End If

If strOrderBy <> vbNullString Then

strSql = strSql & " ORDER BY " & strOrderBy

End If

' Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)

Dim qdf As QueryDef

Set qdf = DBEngine(0)(0).CreateQueryDef("", strSql)

If strParamName <> "" Then

qdf.Parameters(strParamName) = strParamValue

End If

Set rs = qdf.OpenRecordset(dbOpenDynaset)

'Determine if the requested field is multi-valued (Type is above 100.)

'Loop through the matching records

Do While Not rs.EOF

remember dictOut, rs(0)

rs.MoveNext

Loop

rs.Close

Dim strOut As String 'Output string to concatenate to.

Dim key As Variant

For Each key In dictOut

strOut = strOut & key & strSeparator

Next key

'Return the string without the trailing separator.

lngLen = Len(strOut) - Len(strSeparator)

If lngLen > 0 Then

UniqConcatRelated = Left(strOut, lngLen)

End If

Exit_Handler:

'Clean up

Set rsMV = Nothing

Set rs = Nothing

Exit Function

'Err_Handler:

' MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"

' Resume Exit_Handler

End Function

Sub test_UniqConcatRelated()

MsgBox UniqConcatRelated("FIELD_NAME_1", "TABLE_NAME", "FIELD_NAME_2 = ""condition""")

End Sub