今天在室内等待飓风过去,所以我想我会创建这个自定义解决方案。所有这些步骤的答案都可以在其他地方找到,但要对所有人为的解决方案进行分类并不容易,所以我希望这个答案对所有方面都更有用。
将行更改为列的基本答案是here。但与这个问题的数据不同,该答案的样本数据已经正确排序。只要列值 [ID] 和 [Email] 形成唯一对并且没有 NULL 值,就可以使用聚合子查询或调用 Access 聚合函数来生成正确的排序。为了减少查询的总数,我继续在同一个查询中生成了转换后的列名。 (如果值不是唯一的或有空值,排序将被关闭,最终结果将丢失一些数据。)
这里的第二个挑战是有两列需要转换,但 Access SQL 转换语句(即 Crosstab 查询)每个查询只允许一个转换列。创建两个单独的查询然后将它们连接起来相当简单,但由于交叉表查询会生成动态(即未确定的)列数,因此如果不手动按顺序选择每一列,实际上不可能交错电子邮件和评论列。此外,显式指定查询中的列会破坏交叉表查询的动态方面,并且会留下额外的列,或者如果列的总数减少,则会产生错误。
更新:在发布原始解决方案(现在标记为解决方案 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