VBA, MS Access MS Access в примерах

Разворот строки (кокатенация) с разделителем по вертикали запросом

По материалам: https://www.cyberforum.ru/ms-access/thread3035088.html


Дополнительно используется таблица Digits (в примере на 100 записей)

Public Function GetVertVal(lDigit&, vString, Optional sDelimetr$ = ",")
'В запросе возвращает значения строки поворачивая их по вертикали с использованием таблицы "Digits"
'---------------------------------------------------------------------------------------------------
'Аргументы:
'   lDigit      = Значение поля "Digit" из таблицы "Digits"
'   vString     = Строка разделённая запятыми
'   sDelimetr   = Разделитель ; по умолчанию = Запятая
'---------------------------------------------------------------------------------------------------
Static stvVal, stvArr
On Error GoTo GetVertVal_Err
    
    If Len(vString) = 0 Then Exit Function
    If Not stvVal = vString Then
        stvArr = Split(vString, ",")
        stvVal = vString
    End If
    
    GetVertVal = Trim(stvArr(lDigit - 1))

GetVertVal_Err:
    Err.Clear
    Exit Function
End Function


Запрос:

SELECT [ztsNo] AS [No], GetVertVal([Digit],[ztsValues]) AS VertVal, 
	[Digit] AS [Position], ZTest.[ztsValues] AS SourceValue
FROM ZTest, Digits
WHERE (Len(GetVertVal([Digit],[ztsValues])) > 0)
ORDER BY [ztsNo], [Digit];



Делаем из этого:

Picture



это:

Picture


И напомню:
Всё будет быстро если кол-во записей в таблице "Digits" не будет сильно превышать максимальное количество значений в строке перечисления.




Дополнительно:

Private Sub CreateDigitsTable()
'27.10.2022 v001 - Создание Таблицы "Digits" и заполнение её значениями
'---------------------------------------------------------------------------------------------------
Const csTableName$ = "Digits"  'Название таблицы
Const csFieldName$ = "Digit"   'Название таблицы
Const ciTotRecords% = 100      'Кол-во добаляемых записей

Dim tbl As TableDef       'объект таблица
Dim idx As index          'объект индекс
Dim fld As Field          'объект поле
Dim rst As Recordset      'объект набор записей
Dim iVal%
'---------------------------------------------------------------------------------------------------
'Удаляем существующую (если есть)
    On Error Resume Next
    CurrentDb.TableDefs.Delete csTableName
    Err.Clear
    
On Error GoTo CreateDigitsTable_Err

'Создание объектной переменной таблицы, полей и индекса в ней
    Set tbl = CurrentDb.CreateTableDef(csTableName)
    With tbl
        Set fld = tbl.CreateField(csFieldName, dbLong)
        fld.Attributes = dbAutoIncrField   'Счётчик!
        .Fields.Append fld
    'Создание уникального индекса:
            Set idx = .CreateIndex("Primary Key")
                With idx  'Добавление поля в индекс
                    .Fields.Append .CreateField(csFieldName)
                'Установка свойств индекса:
                    .Unique = True   'Уникальный
                    .Primary = True  'Первичный
                End With
            .Indexes.Append idx 'Индекс создан
    End With
'Фактическое добавление таблицы из объектной переменной описанной выше
    CurrentDb.TableDefs.Append tbl
    
'---------------------------------------------------------------------------------------------------
'Заполнение записями:
    Set rst = CurrentDb.OpenRecordset("Digits", dbOpenDynaset)
    For iVal = 1 To ciTotRecords
        With rst
            .AddNew: .Update
        End With
    Next iVal
    
CreateDigitsTable_Bye:
    On Error Resume Next
    Set idx = Nothing:    Set tbl = Nothing
    rst.Close:            Set rst = Nothing
    Exit Sub

CreateDigitsTable_Err:
    MsgBox "Произошла ошибка при выполнении процедуры [CreateDigitsTable] :" & vbCrLf & _
        Err.Description & vbCrLf & "Номер ошибки:" & Err.Number, vbCritical
    Resume CreateDigitsTable_Bye
End Sub




Скачать

MSA-2007 и выше ( 61 kB) Пример


Назад ToTop
L.E. 06.11.2022
Рейтинг@Mail.ru