Разворот строки (кокатенация) с разделителем по вертикали запросомПо материалам: https://www.cyberforum.ru/ms-access/thread3035088.html
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];
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) Пример |
|||
L.E. 06.11.2022 |