Microsoft Access压缩表中的多行

时间：2011-03-02 22:32:06

标签： ms-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

感谢。

4 个答案:

答案 0 :(得分：27)

通常，您必须编写一个允许您创建连锁列表的函数。这是我用过的：。

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;

答案 1 :(得分：3)

这是一个不需要VBA的简单解决方案。它使用更新查询将值连接到字段上。

我会用我正在使用的例子来展示它。

我有一个表“emails_by_team”，其中包含两个字段“team_id”和“email_formatted”。我想要的是用一个字符串收集给定团队的所有电子邮件。

1）我创建了一个表“team_more_info”，其中包含两个字段：“team_id”和“team_emails”

2）使用“emails_by_team”中的所有“team_id”填充“team_more_info”

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

答案 2 :(得分：1)

由于这只是一小部分选项，另一种没有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

答案 3 :(得分：0)

Thomas's GetList function很棒，但是对于我的大数据库来说太慢了。我认为速度下降可能是由于使用ADO引起的，所以我重写了GetList以使用本机DAO调用。

此版本的速度约为 3x ：

Option Compare Database
Option Explicit

' Concatenate multiple values in a query. From:
' https://stackoverflow.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

呼叫签名是相同的，尽管在某些情况下它们可能会给出不同的结果。

此版本还具有不需要您添加手动参考文献as MarredCheese pointed out的优点。

相关问题
最新问题