将列转置为使用Excelmacros的行

我有一个Excel表格，看起来像这样：row1和row2中的每个“行”都有一个项目列表，config，qty和“rows”共享相同的“position”。

+----------+---------+------------------+-------+---------+------------------+-------+ | | 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 | +----------+---------+------------------+-------+---------+------------------+-------+ 

我想用macros来转置看起来像这样。

 +----------+---------+------+--------+------------------+ | 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 | +----------+---------+------+--------+------------------+ 

我怎么能使用macros，因为我的表中有〜20“行”和〜40“职位”。 我是新来的macros，所以希望我可以使这种自动化，否则我手动复制和粘贴他们的所有。 谢谢！

Answer 1

这将工作在你所有的列上。 只要每个行组中有4列。 说明：

获取源表单的最后一行和最后一列。 确定每个组中有多less个列。 在列中遍历一行“ROW＃”（您的标签），遍历所有行。
将数据复制到目标工作表，以所需的格式转到下一个列组

安装程序：您将需要创build一个新的工作表。
例如：“目标”。

然后设置标题行。
例如：数据从目标表的第2行开始

请确保检查代码，以查看源表格中的行和列的开始位置。

在代码中设置源表的名称。

testing：

 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 

编辑：更正了错误的代码