Excel – 转置成对的列
我试图转置 – 如果这是正确的应用这个词 – 成对的列重复行。 具体而言，我需要从这个angular度去做：
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
这个操作将会发生在至less有7对列的数百个“事物”上。 我想不出的部分是如何将这些对作为一个单位进行分组/locking。
在某些方面，我试图做与通常做的相反的事情。 一个例子是： 转置和分组数据，但它不太适合，即使我试图向后看。
编辑：另一个相似的例子，但我需要做的几乎相反： 如何转置一个或多个列对Excel中的匹配logging？
我的VBA功夫很弱，但是我愿意尝试你的集体智慧。
想法是受欢迎的，无论如何，谢谢你的阅读。
这是一个VBA解决scheme。
要实现这个，请按Alt+F11打开VBA编辑器。
右键单击到左侧，然后select“插入模块”
将代码粘贴到此的右侧。
您可能需要更改输出表名称，如代码中所示。
我使用Sheet2来放置转置的数据，但你可以使用任何你想要的。
完成之后，您可以closures编辑器并select包含未转置数据的工作表。
运行macros按下Alt+F8 ，单击macros，然后按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
input：
输出：
编辑：如果你想添加一个额外的列，也只是显示在旁边，你可以像这样改变代码：
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列中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我们说，也匹配第二列。
希望我做了一个体面的工作解释。
以下是Excel公式解决scheme以防万一。 如果源数据从A1开始，则第一个目标单元格中的公式将为=$A$1 ，右边的2个公式将为
= OFFSET( A$1, 0, ROW( A1 ) * 2 - 1 )
和
= OFFSET( A$1, 0, ROW( A1 ) * 2 )
复制3个公式单元格并粘贴在它们下面的范围内
更新
VBA版本（将r设置为源范围，并将c3replace为目标范围中的第一个单元格）
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)))"