Microsoft Access сжимает несколько строк в таблице

Question

У меня есть вопрос в MS Access 2007, и я надеюсь, что у кого-то есть ответ. У меня есть длинная, но простая таблица с именами клиентов и днями недели, когда производятся поставки. Я хотел бы обобщить эту таблицу, перечислив имя и все дни в одно новое поле "ALLDays", сохраняя при этом все данные.

Исходная таблица выглядит примерно так:

Name         Day  
CustomerA    Monday  
CustomerA    Thursday  
CustomerB    Tuesday  
CustomerB    Friday  
CustomerC    Wednesday  
CustomerC    Saturday  

Я хотел бы иметь запрос, который возвращает результаты, как это:

Name         ALLDays  
CustomerA    Monday, Thursday  
CustomerB    Tuesday, Friday  
CustomerC    Wednesday, Saturday  

Благодарю.

Answer 1

Обычно вам нужно написать функцию, которая позволит вам создать составной список. Вот что я использовал:

Public Function GetList(SQL As String _
                            , Optional ColumnDelimeter As String = ", " _
                            , Optional RowDelimeter As String = vbCrLf) As String
'PURPOSE: to return a combined string from the passed query
'ARGS:
'   1. SQL is a valid Select statement
'   2. ColumnDelimiter is the character(s) that separate each column
'   3. RowDelimiter is the character(s) that separate each row
'RETURN VAL: Concatenated list
'DESIGN NOTES:
'EXAMPLE CALL: =GetList("Select Col1,Col2 From Table1 Where Table1.Key = " & OuterTable.Key)

Const PROCNAME = "GetList"
Const adClipString = 2
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim sResult As String

On Error GoTo ProcErr

Set oConn = CurrentProject.Connection
Set oRS = oConn.Execute(SQL)

sResult = oRS.GetString(adClipString, -1, ColumnDelimeter, RowDelimeter)

If Right(sResult, Len(RowDelimeter)) = RowDelimeter Then
    sResult = Mid$(sResult, 1, Len(sResult) - Len(RowDelimeter))
End If

GetList = sResult
oRS.Close
oConn.Close

CleanUp:
    Set oRS = Nothing
    Set oConn = Nothing

Exit Function
ProcErr:
    ' insert error handler
    Resume CleanUp

End Function

Версия Remou имеет дополнительную функцию, позволяющую передавать массив значений вместо оператора SQL.

---

Пример запроса может выглядеть так:

SELECT SourceTable.Name
    , GetList("Select Day From SourceTable As T1 Where T1.Name = """ & [SourceTable].[Name] & """","",", ") AS Expr1
FROM SourceTable
GROUP BY SourceTable.Name;

Answer 2

Вот простое решение, которое не требует VBA. Он использует запрос на обновление для объединения значений в поле.

Я покажу это на примере, который я использую.

У меня есть таблица "emails_by_team", в которой есть два поля "team_id" и "email_formatted". То, что я хочу, это собрать все электронные письма для данной команды в одну строку.

1) Я создаю таблицу "team_more_info", которая имеет два поля: "team_id" и "team_emails"

2) заполнить "team_more_info" всеми "team_id" из "emails_by_team"

3) создать запрос на обновление, который устанавливает для "emails_by_team" значение NULL
Имя запроса: team_email_collection_clear

UPDATE team_more_info 
SET team_more_info.team_emails = Null;

4) Это хитрость здесь: создать обновление запроса
Имя запроса: team_email_collection_update

UPDATE team_more_info INNER JOIN emails_by_team 
  ON team_more_info.team_id = emails_by_team.team_id 
SET team_more_info.team_emails = 
    IIf(IsNull([team_emails]),[email_formatted],[team_emails] & "; " & [email_formatted]);

5) для обновления информации создайте макрос, который запускает два запроса при необходимости

Первый: team_email_collection_clear

Второе: team_email_collection_update

QED

Answer 3

Так как это всего лишь небольшой выбор вариантов, другой подход без VBA состоит в том, чтобы создать серию операторов IIF и объединить результаты.

SELECT name, 
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, ") AS AllDays
FROM Table1
GROUP BY name

Если вы перфекционист, вы можете даже избавиться от последней запятой, как это

SELECT name, 
LEFT(
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, "),
LEN(
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, ")
) - 2
)
AS AllDays
FROM Table1
GROUP BY name

Вы также можете рассмотреть возможность их хранения в отдельных столбцах, так как это может оказаться более полезным при доступе к этому запросу из другого. Например, таким способом было бы проще найти только экземпляры со вторником. Что-то вроде:

SELECT name, 
IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday") AS Monday,  
IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday") AS Tuesday,
IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday") AS Wednesday,
IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday") AS Thursday,
IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday") AS Friday,
IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday") AS Saturday,
IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday") AS Sunday
FROM Table1
GROUP BY name

Answer 4

Функция Томаса GetList великолепна, но она была слишком медленной для моей большой базы данных. Я думаю, что замедление может быть вызвано использованием ADO, поэтому я переписал GetList для использования собственных вызовов DAO.

Эта версия примерно в 3 раза быстрее:

Option Compare Database
Option Explicit

' Concatenate multiple values in a query. From:
' https://stackru.com/questions/5174362/microsoft-access-condense-multiple-lines-in-a-table/5174843#5174843
'
' Note that using a StringBuilder class from here:
' https://codereview.stackexchange.com/questions/67596/a-lightning-fast-stringbuilder/154792#154792
' offers no code speed up

Public Function GetListOptimal( _
    SQL As String, _
    Optional fieldDelim As String = ", ", _
    Optional recordDelim As String = vbCrLf _
    ) As String

    Dim dbs As Database
    Dim rs As Recordset
    Dim records() As Variant
    Dim recordCount As Long

    ' return values
    Dim ret As String
    Dim recordString As String
    ret = ""
    recordString = ""

    ' index vars
    Dim recordN As Integer
    Dim fieldN As Integer
    Dim currentField As Variant

    ' array bounds vars
    Dim recordsLBField As Integer
    Dim recordsUBField As Integer
    Dim recordsLBRecord As Integer
    Dim recordsUBRecord As Integer

    ' get data from db
    Set dbs = CurrentDb
    Set rs = dbs.OpenRecordset(SQL)
    recordCount = rs.recordCount

    ' Guard against no records returned
    If recordCount = 0 Then
        GetListOptimal = ""
        Exit Function
    End If

    records = rs.GetRows(recordCount)

    ' assign bounds of data
    recordsLBField = LBound(records, 1)    ' should always be 0, I think
    recordsUBField = UBound(records, 1)
    recordsLBRecord = LBound(records, 2)    ' should always be 0, I think
    recordsUBRecord = UBound(records, 2)

    ' FYI vba will loop thorugh every For loop at least once, even if
    ' both LBound and UBound are 0.  We already checked to ensure that
    ' there is at least one record, and that also ensures that
    ' there is at least one record.  I think...
    ' Can a SQL query return >0 records with 0 fields each?
    For recordN = recordsLBRecord To recordsUBRecord
        For fieldN = recordsLBField To recordsUBField
            ' Only add fieldDelim after at least one field
            If recordString <> "" Then
                recordString = recordString & fieldDelim
            End If

            ' records is indexed (field, record) for some reason
            currentField = records(fieldN, recordN)

            ' Guard against null-valued fields
            If Not IsNull(currentField) Then
                recordString = recordString & CStr(currentField)
            End If
        Next fieldN

        ' Only add recordDelim after at least one record
        If ret <> "" Then
            ret = ret & recordDelim
        End If
        ret = ret & recordString

        recordString = ""   ' Re-initialize to ensure no old data problems
    Next recordN

    ' adds final recordDelim at end output
    ' not sure when this might be a good idea
    ' TODO: Implement switch parameter to control
    ' this, rather than just disabling it
    ' If ret <> "" Then
    '    ret = ret & recordDelim
    ' End If

    ' Cleanup db objects
    Set dbs = Nothing
    Set rs = Nothing

    GetListOptimal = ret
    Exit Function
End Function

Сигнатуры вызовов идентичны, хотя, возможно, существуют крайние случаи, когда они дают разные результаты.

Эта версия также имеет то преимущество, что не требует добавления справочника вручную, как указал MarredCheese.