Question

我有一个以交叉表格式排列的excel文件，需要进行纵向转换。

我所拥有的：

|-id-|-f1-|-f2-|-f3-|
|-1--|-a--|-b--|-c--|
|-1--|-a--|-x--|-y--|
|-2--|-1--|null|-9--|
|-2--|-f--|-1--|null|      
|-2--|-a--|-v--|-2--|

我需要什么：

|-id-|-f1-|-f2-|-f3-|-id-|-f1-|-f2-|-f3-|-id-|-f1-|-f2-|-f3-|
|-1--|-a--|-b--|-c--|-1--|-a--|-x--|-y--|null|null|null|null|
|-2--|-1--|null|-9--|-2--|-f--|-1--|null|-2--|-a--|-v--|-2--|

我需要一个宏或VBA代码，可以在数百行/列上快速轻松地运行，并自动将纵向排列的数据放入新的工作表中。

我在网上找到了这个。它完全按照我的意愿覆盖了文件，但是，您必须手动选择要合并的行。我正在寻找可以找到唯一ID并自行进行压缩的东西。

Sub TransformOneRow()
'Updateby20131120
Dim InputRng As Range, OutRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Ranges to be transform :", xTitleId, 
InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste to (single cell):", xTitleId, 
Type:=8)
Application.ScreenUpdating = False
xRows = InputRng.Rows.Count
xCols = InputRng.Columns.Count
For i = 1 To xRows
    InputRng.Rows(i).Copy OutRng
    Set OutRng = OutRng.Offset(0, xCols + 0)
Next
Application.ScreenUpdating = True
End Sub

感谢您的帮助！

-更新-

我仍然没有弄清楚如何使用宏执行此操作，但是这是一个不错的解决方法，如果其他任何人都遇到同样的问题，它也不会耗费大量人力或时间：

https://www.excel-university.com/combine-rows-into-a-delimited-list/

并作为解决上述方法的一些问题的补充：

https://community.powerbi.com/t5/Desktop/Error-DataFormat-Error-We-couldn-t-convert-to-Number-Details/m-p/150897#M65221

Answer 1

这应该做您想要的。

Sub TryThis()

Dim xRg As Range
Dim xRows As Long
Dim I As Long, J As Long, K As Long
On Error Resume Next
Set xRg = Application.InputBox("Select Range:", "Kutools For Excel", Selection.Address, , , , , 8)
Set xRg = Range(Intersect(xRg, ActiveSheet.UsedRange).Address)
If xRg Is Nothing Then Exit Sub
xRows = xRg.Rows.Count
For I = xRows To 2 Step -1
For J = 1 To I - 1
If xRg(I, 1).Value = xRg(J, 1).Value And J <> I Then
For K = 2 To xRg.Columns.Count
If xRg(J, K).Value <> "" Then
If xRg(I, K).Value = "" Then
xRg(I, K) = xRg(J, K).Value
Else
xRg(I, K) = xRg(I, K).Value & "," & xRg(J, K).Value
End If
End If
Next
xRg(J, 1).EntireRow.Delete
I = I - 1
J = J - 1
End If
Next
Next
ActiveSheet.UsedRange.Columns.AutoFit

End Sub

另外，请考虑使用Power Query，您可以从下面的链接中获得。

https://www.microsoft.com/en-us/download/details.aspx?id=39379

Excel根据唯一ID将交叉表数据转换为纵向数据

1 个答案: