![]() |
![]() |
||
Сборка значений полей (конкатенация) по записям из источника данных (DAO)По материалам: https://www.cyberforum.ru/ms-access/thread3007700.html Public Function RecordsToStr(PacID As Long) As String 'Например: = RecordsToStr([идОбъект]) Dim sSQL$ sSQL = "SELECT Препарат FROM [Схемы лечения] WHERE [Номер пациента] =" & PacID RecordsToStr = QueryDataToLine(sSQL) End Function Private Function QueryDataToLine(sSQLStr, Optional sFieldName$ = "", Optional sCut$ = ", ") As String 'es 29.08.2018 LE 14.07.2022 'Возвращает строку по данным запроса (сборка значений поля по всем записям - одной строкой) '-------------------------------------------------------------------------- 'Аргументы: ' sSQLStr - SQL строчка источник аданных (Название запроса - Таблицы) ' sFieldName - Название поля в источнике данных - Откуда?! ' sCut - Опционально: Разделитель значений (по умолчанию = ", ") '-------------------------------------------------------------------------- ' = QueryDataToLine( "Запрос_СписокМатериалов"; "Материал", "; " ) '-------------------------------------------------------------------------- Dim rst As DAO.Recordset Dim i As Integer Dim fld As Field, v As Variant On Error GoTo QueryDataToLine_Err Set rst = CurrentDb.OpenRecordset(sSQLStr, dbOpenSnapshot) With rst Do Until .EOF = True 'Цикл до конца If sFieldName = "" Then 'Поле не задано For Each fld In rst.Fields v = v + sCut & fld.Value 'Конкатенация строки v1 Next fld Else 'Поле задано чётко v = v & sCut & .Fields(sFieldName) 'Конкатенация строки v2 End If .MoveNext Loop End With If Len(v) > 2 Then QueryDataToLine = Mid(v, 3) QueryDataToLine_End: On Error Resume Next rst.Close Set rst = Nothing Exit Function QueryDataToLine_Err: QueryDataToLine = "ERR: " & Err.Number Resume QueryDataToLine_End End Function
SELECT [Номер пациента] AS КодПациента, RecordsToStr([Номер пациента]) AS Препараты FROM [Схемы лечения] GROUP BY [Номер пациента] ORDER BY [Номер пациента];
MSA-2007 и выше ( 200 kB) Пример |
![]() ![]() |
||
L.E. 14.02.2023 |