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

У меня вопрос в 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

Спасибо.

ОТВЕТЫ

Ответ 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;

Ответ 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

КЭД

Ответ 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

Ответ 4

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

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

Option Compare Database
Option Explicit

' Concatenate multiple values in a query. From:
' /info/301898/microsoft-access-condense-multiple-lines-in-a-table/1480199#1480199
'
' Note that using a StringBuilder class from here:
' https://codereview.stackexchange.com/info/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.