使用唯一键将多行转换为列

时间:2017-08-26 18:43:39

标签: ms-access access-vba transform pivot-table

我很新,所以我想知道是否有人可以帮助我满足以下要求。我试图创建一个查询来提取表值,将它们组合成一个以唯一标识符(ID)分组的同一行。

我已经考虑过尝试使用交叉表查询,但它们似乎更多地用于执行计算并使用PIVOT函数,但它似乎也不符合我的要求。

任何帮助真的很感激。请参阅下面的数据示例。

我的数据具有以下格式

ID    EMAIL                   COMMENTS
1     email1@email.com        <TEXT>
1     email2@email.com        <TEXT>
2     email1@email.com        <TEXT>
2     email2@email.com        <TEXT>
2     emailN@email.com        <TEXT>

期望输出

ID COL1             COL2   COL3              COL4   COLN                 COLN+1
1  email1@email.com <TEXT> email2@email.com  <TEXT>
2  email1@email.com <TEXT> email2@email.com  <TEXT> emailN@email.com     <TEXT>

1 个答案:

答案 0 :(得分:2)

今天在室内等待飓风,所以我想我会创建这个自定义解决方案。所有这些步骤的答案都可以在其他地方找到,但是对所有人工解决方案进行排序并不简单,所以我希望这个答案在各方面都更有用。

将行更改为列的基本答案是here。但与该问题的数据不同,该答案的样本数据已经正确排序。只要列值[ID]和[Email]形成唯一对并且具有NO NULL值,则可以使用聚合子查询或对Access聚合函数的调用来生成正确的排序。为了减少查询的总数,我继续在同一查询中生成转换后的列名。 (如果值不是唯一的或具有空值,则排序将关闭,最终结果将丢失一些数据。)

这里的第二个挑战是需要转换两列,但Access SQL转换语句(即交叉表查询)仅允许每个查询一个转换列。创建两个单独的查询然后加入它们相当简单,但由于交叉表查询生成一个动态(即未确定)列数,因此无需手动按顺序选择每列,就无法交错电子邮件和注释列。此外,明确指定查询中的哪些列会破坏交叉表查询的动态方面,并且会将其他列排除,或者如果列总数减少则会生成错误。

更新:在发布原始解决方案(现在标记为解决方案2)之后,我意识到我可以通过实际向后退一步来解决列交错问题... 首先生成更多行 - 每个电子邮件地址的一行和每个评论的单独行 - 在最终转换之前将它们再次放在同一行上。

解决方案1 ​​

保存以下查询并将其命名为[Sequenced]。为了便于在最终输出中进行正确的列排序,我使用了“备注”而不是“评论”这个词,因为它在“电子邮件”后排序:

SELECT Data.ID, Data.Email, Data.Comments,
    1 + DCount("[ID]","Data","[ID]=" & [ID] & " and [Email]<'" & Replace([Email],"'","''") & "'") AS SeqNum,
    Format([SeqNum],"000") & ' Email' AS EmailColumn,
    Format([SeqNum],"000") & ' Remark' AS CommentsColumn
FROM Data
ORDER BY Data.ID, Data.Email;

保存以下查询并将其命名为[Backwards]:

SELECT ID, EmailColumn AS ColumnName, Email AS [Value]
FROM Sequenced
UNION SELECT ID, CommentsColumn AS ColumnName, Comments AS [Value]
FROM Sequenced
ORDER BY [ID], [ColumnName];

保存以下查询并将其命名为[InterleavedCrosstab]:

TRANSFORM First(Backwards.Value) AS FirstOfValue
SELECT Backwards.ID
FROM Backwards
GROUP BY Backwards.ID
ORDER BY Backwards.ID, Backwards.ColumnName
PIVOT Backwards.ColumnName;

解决方案2

保存以下查询并将其命名为[Sequenced2]:

SELECT Data.ID, Data.Email, Data.Comments,
    1 + DCount("[ID]","Data","[ID]=" & [ID] & " and [Email]<'" & Replace([Email],"'","''") & "'") AS SeqNum,
    'Email' & Format([SeqNum],"000") AS EmailColumn,
    'Comments' & Format([SeqNum],"000") AS CommentsColumn
FROM Data
ORDER BY Data.ID, Data.Email;

保存以下查询并将其命名为[EmailCrosstab]:

TRANSFORM First(Sequenced2.Email) AS FirstOfEmail
SELECT Sequenced2.ID
FROM Sequenced2
GROUP BY Sequenced2.ID
ORDER BY Sequenced2.ID
PIVOT Sequenced2.EmailColumn;

保存以下查询并将其命名为[CommentsCrosstab]:

TRANSFORM First(Sequenced2.Comments) AS FirstOfComments
SELECT Sequenced2.ID
FROM Sequenced2
GROUP BY Sequenced2.ID
ORDER BY Sequenced2.ID
PIVOT Sequenced2.CommentsColumn;

最后,最常规的结果查询将返回所有列,但它们不会交错,并且会复制[ID]列:

SELECT EmailCrosstab.*,
       CommentsCrosstab.*
FROM CommentsCrosstab INNER JOIN EmailCrosstab
    ON CommentsCrosstab.ID = EmailCrosstab.ID;

这是一个美化版本,但最多只有3个电子邮件和评论栏:

SELECT EmailCrosstab.ID,
    EmailCrosstab.Email001,CommentsCrosstab.Comments001,
    EmailCrosstab.Email002,CommentsCrosstab.Comments002,
    EmailCrosstab.Email003,CommentsCrosstab.Comments003
FROM CommentsCrosstab INNER JOIN EmailCrosstab
    ON CommentsCrosstab.ID = EmailCrosstab.ID;

解决方案3

当我意识到仅查询解决方案相当容易时,我已经输入了以下VBA程序,所以这里有一个额外的替代方案。

Public Sub CustomTransform()
  '* This code assumes that the field values
  '* [ID] and [Email] constitute a unique pair
  '* and that there are NO NULL values.

  Dim i As Integer, MaxIDRows As Integer
  Dim IDSeq As Integer
  Dim lastID As Long
  Dim IDstring As String
  Dim tbl As TableDef
  Dim idx As Index
  Dim db As Database
  Dim rsSrc As Recordset2, rsResult As Recordset2
  Const resultTable As String = "Customer Crosstab"

  Set db = CurrentDb

  MaxIDRows = db.OpenRecordset( _
      "SELECT Max(Counter.Rows) AS MaxRows" & _
      " FROM ( SELECT Count(Data.[ID]) AS [Rows]" & _
        " FROM Data GROUP BY Data.[ID]) AS Counter" _
      ).Fields(0).Value

  '* Column count <= 254 : ID + N * (Email + Comment columns)
  If MaxIDRows = 0 Then
    MsgBox "No data.", vbOKOnly Or vbExclamation, "No Data"
    Exit Sub
  ElseIf MaxIDRows >= 252 / 2 Then
    MsgBox "Maximum number of columns exceeded.", _
        vbOKOnly Or vbExclamation, "Maximum Columns Exceeded"
    Exit Sub
  End If

  On Error Resume Next
  db.TableDefs.Delete resultTable
  Err.Clear
  On Error GoTo 0

  Set tbl = db.CreateTableDef(resultTable)
  With tbl
    ' Create fields and append them to the new TableDef
    ' object. This must be done before appending the
    ' TableDef object to the TableDefs collection of the
    ' Northwind database.
    .Fields.Append .CreateField("ID", dbLong)

    For i = 1 To MaxIDRows
      IDstring = Format(i, "000")
      .Fields.Append .CreateField("Email" & IDstring, dbText, 255)
      .Fields.Append .CreateField("Comments" & IDstring, dbText, 255)
    Next

    Set idx = .CreateIndex("Primary Key")
    idx.Fields.Append idx.CreateField("ID")
    idx.Primary = True
    .Indexes.Append idx
  End With
  db.TableDefs.Append tbl

  Set rsResult = db.OpenRecordset(resultTable, dbOpenTable)
  Set rsSrc = db.OpenRecordset( _
      "SELECT ID, Email, Comments" & _
      " FROM Data" & _
      " ORDER BY ID, Email")

  lastID = -1
  Do Until rsSrc.EOF
    If rsSrc!id <> lastID Then
      If lastID <> -1 Then
        rsResult.Update
      End If

      IDSeq = 0
      rsResult.AddNew
      rsResult!id = rsSrc!id
    End If
    lastID = rsSrc!id

    IDSeq = IDSeq + 1
    IDstring = Format(IDSeq, "000")

    rsResult.Fields("Email" & IDstring) = rsSrc!email
    rsResult.Fields("Comments" & IDstring) = rsSrc!Comments

    rsSrc.MoveNext
  Loop
  rsSrc.Close

  If rsResult.EditMode <> dbEditNone Then
    rsResult.Update
  End If
  rsResult.Close

  Debug.Print "CustomTransform Done"
End Sub