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 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

 



© 2018 | Анна Петросян | pashelp@yandex.ru