使用excel宏将列转置为行

Question

我有一张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 |
+----------+---------+------------------+-------+---------+------------------+-------+

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

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

+----------+---------+------+--------+------------------+

如何使用宏来实现，因为我的工作表中有~20“行”和~40“位置”。我是宏的新手，所以希望我可以自动化，否则我会手动复制和粘贴所有这些。 谢谢！

Answer 1

这将适用于您拥有的任意数量的列。只要每个Row组中有4列。 的说明：

获取源表和最后一列的最后一行。确定每个组中有多少列。 循环遍历列组一次“ROW＃”（您的标签），直到所有行深 以您想要的格式将数据复制到目标工作表 转到下一个列组

<强>设置： 您需要创建一个新的工作表      例如：“目标”。

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

确保检查代码以查看源表上的列和行的开始位置。

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

<强>试验：

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

编辑：修正了代码中的拼写错误