Excel - 转置成对列

Question

我试图转置 - 如果这是该术语的正确应用 - 将列对成重复行。具体而言，我需要从中得出结论：

Thing1     6    0.29    5   0.23    7   0.19    8   0.11

到此：

Thing1     6    0.29
Thing1     5    0.23
Thing1     7    0.19
Thing1     8    0.11

对于几百个事物，至少有7对列会发生此操作。＆＃34;我无法弄清楚的部分是如何将要处理的对分组/锁定为一个单元。

在某些方面，我试图做与正常做法相反的事情。这里有一个例子：Transpose and group data但它并不适合，即使我试图向后看它。

编辑：另一个类似的例子，但我需要做的几乎相反：How to transpose one or more column pairs to the matching record in Excel?

我的VBA功夫很弱，但我愿意尝试你的集体智慧所建议的任何东西。

欢迎提出意见，无论如何，感谢您阅读。

Answer 1

以下是Excel公式解决方案以防万一。如果源数据从A1开始，则第一个目标单元格中​​的公式将为=$A$1，右侧的2个公式将为

= OFFSET( A$1, 0, ROW( A1 ) * 2 - 1 )

和

= OFFSET( A$1, 0, ROW( A1 ) * 2 )

复制3个配方单元并粘贴在它们下面的范围内

<强>更新

VBA版本（将r设置为源范围并将c3替换为目标范围中的第一个单元格）

Set r = [a1:i1]
set d = [c3].Resize(r.Count \ 2, 3)
d.Formula = "=index(" & r.Address & ",if(column(a1)=1,1,row(a1)*2-2+column(a1)))"

Answer 2

这是一个VBA解决方案。

要实现此功能，请按Alt+F11以打开VBA编辑器。

右键单击左侧并选择＆＃34;插入模块＆＃34;

将代码粘贴到此右侧。

您可能希望更改输出表名称，如我在代码中所示。

我使用Sheet2放置转置数据，但您可以随意使用。

完成此操作后，您可以关闭编辑器并选择包含非转置数据的工作表。

按Alt+F8，点击宏，然后按Run

运行宏

Sheet2应包含您要查找的结果。

Sub ForJeremy() 'You can call this whatever you want
Dim EndCol, OutSheet, OutRow, c, x
Application.ScreenUpdating = False
EndCol = ActiveSheet.UsedRange.columns.Count

'What sheet do I put these values on?
Set OutSheet = Sheets("Sheet2") 'Put the name in the quotes

OutSheet.Cells.Delete xlShiftUp 'This clears the output sheet.
OutRow = 1
For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
    For x = 2 To EndCol Step 2
        OutSheet.Cells(OutRow, 1) = c.Value
        OutSheet.Cells(OutRow, 2) = Cells(c.Row, x)
        OutSheet.Cells(OutRow, 3) = Cells(c.Row, x + 1)
        OutRow = OutRow + 1
    Next x
Next c
OutSheet.Select
Application.ScreenUpdating = True
End Sub

输入：

输出：

编辑：如果你想在开头添加一个额外的列，它也会显示在旁边，你可以像这样更改代码：

For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
    For x = 3 To EndCol Step 2 'Changed 2 to 3
        OutSheet.Cells(OutRow, 1) = c.Value
        OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line
        OutSheet.Cells(OutRow, 3) = Cells(c.Row, x) 'Changed to Col 3
        OutSheet.Cells(OutRow, 4) = Cells(c.Row, x + 1) 'Changed to Col 4
        OutRow = OutRow + 1
    Next x
Next c

为了更好地解释这个循环，

它从顶部到底部遍历列A中的每个单元格。

内部循环一次超过2列。

所以我们从列B开始，接下来是D，接下来是F ..依此类推。

所以一旦我们拥有了这个价值，我们也会抓住它右边的价值。

这是Cells(c.Row, x)和Cells(c.Row, x + 1)的作用。

OutSheet.Cells(OutRow, 1) = c.Value说 - 只需将第一列与第一列匹配即可。

当我们添加第二个时，OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line我们说，也匹配第二列。

希望我做得不错。