使用 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

编辑：更正代码中的错字