vba 使用 excel 宏将列转置为行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27307003/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Transpose columns to rows using excel macro
提问by Angie Li
I have a excel sheet looks like this: Each "row" like row1 and row2 has a list of items, config, qty, and "rows" are sharing same "position".
我有一个像这样的 Excel 工作表：每个“行”（如 row1 和 row2）都有一个项目列表，配置、数量和“行”共享相同的“位置”。
+----------+---------+------------------+-------+---------+------------------+-------+
| | row1 | row2 |
+----------+---------+------------------+-------+---------+------------------+-------+
|position | item | Configuration | qty | item | Configuration | qty |
+----------+---------+------------------+-------+---------+------------------+-------+
| 1 | Spaced | | Spaced | 0.00 | Spaced | | Spaced | 0.00 |
| 2 | NoFiber | | NoFiber | 0.00 | NoFiber | | NoFiber | 0.00 |
| 3 | NoFiber | | NoFiber | 0.00 | NoFiber | | NoFiber | 0.00 |
| 4 | Empty | inla | Empty | 0.00 | Empty | inkz | Empty | 0.00 |
| 5 | Empty | inla | Empty | 0.00 | Empty | inkz | Empty | 0.00 |
| 6 | Empty | inkq | Empty | 0.00 | Empty | inkp | Empty | 0.00 |
| 7 | Empty | inkq | Empty | 0.00 | Empty | inkp | Empty | 0.00 |
| 8 | Empty | inkf | Empty | 0.00 | Empty | inke | Empty | 0.00 |
| 9 | Empty | inkf | Empty | 0.00 | Empty | inke | Empty | 0.00 |
| 10 | 98211 | inht inid | Iota | 19.23 | 98210 | inhs inic | Iota | 19.23 |
| 11 | 98209 | ingy inhj | Iota | 19.23 | 98208 | ingx inhi | Iota | 19.23 |
| 12 | Spaced | ingo | Spaced | 0.00 | Spaced | ingn | Spaced | 0.00 |
| 13 | 99186 | ingo | Ibis | 54.79 | 99185 | ingn | Ibis | 54.79 |
+----------+---------+------------------+-------+---------+------------------+-------+
I want to use macro to transpose to look like this.
我想用宏转置成这样。
+----------+---------+------+--------+------------------+
| position | bbnum | row | qty | Configuration |
+----------+---------+------+--------+------------------+
| 1 | Spaced | row1 | 0 | | Spaced |
| 2 | NoFiber | row1 | 0 | | NoFiber |
| 3 | NoFiber | row1 | 0 | | NoFiber |
| 4 | Empty | row1 | 0 | inla | Empty |
| 5 | Empty | row1 | 0 | inla | Empty |
| 6 | Empty | row1 | 0 | inkq | Empty |
| 7 | Empty | row1 | 0 | inkq | Empty |
| 8 | Empty | row1 | 0 | inkf | Empty |
| 9 | Empty | row1 | 0 | inkf | Empty |
| 10 | 98211 | row1 | 19.228 | inht inid | Iota |
| 11 | 98209 | row1 | 19.228 | ingy inhj | Iota |
| 12 | Spaced | row1 | 0 | ingo | Spaced |
| 13 | 99186 | row1 | 54.791 | ingo | Ibis |
| 1 | Spaced | row2 | 0 | | Spaced |
| 2 | NoFiber | row2 | 0 | | NoFiber |
| 3 | NoFiber | row2 | 0 | | NoFiber |
| 4 | Empty | row2 | 0 | inkz | Empty |
| 5 | Empty | row2 | 0 | inkz | Empty |
| 6 | Empty | row2 | 0 | inkp | Empty |
| 7 | Empty | row2 | 0 | inkp | Empty |
| 8 | Empty | row2 | 0 | inke | Empty |
| 9 | Empty | row2 | 0 | inke | Empty |
| 10 | 98210 | row2 | 19.23 | inhs inic | Iota |
| 11 | 98208 | row2 | 19.23 | ingx inhi | Iota |
| 12 | Spaced | row2 | 0 | ingn | Spaced |
| 13 | 99185 | row2 | 54.79 | ingn | Ibis |
+----------+---------+------+--------+------------------+
How can I make it happen using macro since there are ~20 "rows" and ~40 "positions" in my sheet. I'm new to macro so hopefully I can make this automated otherwise I'm copying and pasting all of them manually. Thanks!
我怎样才能使用宏实现它，因为我的工作表中有 ~20 个“行”和 ~40 个“位置”。我是宏的新手，所以希望我可以将其自动化，否则我将手动复制和粘贴所有这些。谢谢！
回答by peege
This will work over as many columns as you have. As long as there are 4 columns in each Row group. Explanation:
这将适用于您拥有的尽可能多的列。只要每个 Row 组中有 4 列。 解释：
Get the last row of the source sheet and the last column. Identify how many columns are in each group.
Loop through the column groups one "ROW#" (your label) at a time, through all rows deep.
Copy the data to the target sheet, in the format you want
Go to next Column Group
获取源工作表的最后一行和最后一列。确定每组中有多少列。一次循环遍历列组一个“ROW#”（您的标签），遍历所有行深。
将数据复制到目标工作表，以您想要的格式转到下一个列组
Setup:You will need to create a new Sheet.
example: "Target".
设置：您需要创建一个新工作表。
例如：“目标”。
Then set up the header rows.
example: data starts on row 2 of Target Sheet
然后设置标题行。
示例：数据从目标表的第 2 行开始
Make sure to check the code to see where the columns and rows begin on the source sheet.
确保检查代码以查看列和行在源工作表上的开始位置。
Set the name of your source sheet in the code.
在代码中设置源表的名称。
TESTED:
测试：
Sub ColumnCopy()
Dim lastRow As Long
Dim lastCol As Long
Dim colBase As Long
Dim tRow As Long
Dim source As String
Dim target As String
source = "Sheet1" 'Set your source sheet here
target = "Target" 'Set the Target sheet name
tRow = 2 'Define the start row of the target sheet
'Get Last Row and Column
lastRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).Row
lastCol = Sheets(source).Cells(2, Columns.Count).End(xlToLeft).Column
tRow = 2
colBase = 2
Do While colBase < lastCol
For iRow = 3 To lastRow
Sheets(target).Cells(tRow, 1) = Sheets(source).Cells(iRow, 1) 'Position
Sheets(target).Cells(tRow, 2) = Sheets(source).Cells(iRow, colBase) 'bbnum
Sheets(target).Cells(tRow, 3) = Sheets(source).Cells(1, colBase) 'Getting The Row#, from Row 1
Sheets(target).Cells(tRow, 4) = Sheets(source).Cells(iRow, colBase + 3) 'qty
Sheets(target).Cells(tRow, 5) = Sheets(source).Cells(iRow, colBase + 1) 'Configuration Col 1
Sheets(target).Cells(tRow, 6) = Sheets(source).Cells(iRow, colBase + 2) 'Configuration Col 2
tRow = tRow + 1
Next iRow
colBase = colBase + 4 'Add 4 to the Column Base. This shifts the loop over to the next Row set.
Loop
End Sub
edit:corrected typo in code
编辑：更正代码中的错字
