宏将数据从x列数重新排列为x列数，然后向下复制A和B行中的数据

Question

电子表格中的数据排列不当，数量相当可观。 当前格式具有公司，产品名称和随后列出的成分。 所有成分都有自己的没有标题的列。 例如，我很抱歉，这在下面没有反映出来，因为我对标记语言很不好，A列将被标记为Manufacturer ，B列将被标记为Product Name ，C列将被标记为Ingredients，但是其余的列为未贴标签。

最终，我需要将数据移动到新表中，其中数据仅出现在A，B和C列中。每种产品所含成分的数量各不相同。

我希望所需的格式有帮助。

当前格式：

1| Acme Inc.    | ABC123       | Water       | Sugar     | Eggs    | Salt
2| Acme Inc.    | BCD456       | Cornmeal    | Salt
3| JJ Baking    | JJ4567       | Flour       | Nuts      | Fruit

所需格式：

1| Acme Inc. | ABC123 | Water
2| Acme Inc. | ABC123 | Sugar
3| Acme Inc. | ABC123 | Eggs
4| Acme Inc. | ABC123 | Salt
5| Acme Inc. | BCD456 | Cornmeal
6| Acme Inc. | BCD456 | Salt
7| JJ Baking | JJ4567 | Flour
8| JJ Baking | JJ4567 | Nuts
9| JJ Baking | JJ4567 | Fruit

Answer 1

这是一个应该起作用的简短示例：

Sub test()
Dim lastRow&, lastCol&, noItems&
Dim i&, k&
' This macro will assume your column A and B are constant, and your items will start in column C
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lastRow To 1 Step -1
    lastCol = Cells(i, Columns.Count).End(xlToLeft).Column
    noItems = WorksheetFunction.CountA(Range(Cells(i, 3), Cells(i, lastCol)))

    ' Now we know how many items, so add the info to the new rows.
    ' Start with the name and col B
    Range(Cells(i + 1, 1), Cells(i + noItems - 1, 1)).EntireRow.Insert
    Range(Cells(i, 1), Cells(i + noItems - 1, 2)).FillDown
    For k = 1 To noItems - 1
        Cells(i + k, 3).Value = Cells(i, 3 + k).Value
        Cells(i, 3 + k).Value = ""
    Next k

Next i

End Sub

它将在[C列]中查找[该行的最后一列，右移]，然后创建新行以适应其中的项目数量。

Answer 2

这应该可以解决问题，我在代码注释中加入了许多假设。

我的主要观点是，数据列之间没有间隙。 EG：D列已填写，E列为空白，F列已填写。

另外，列A的条目没有“空白”行，并且当我们看到空白行时，该函数停止。 请在“工作表名称”中填写“自定义工作表名称”。

Public Sub ReOrder()
    Dim sheet As Worksheet
    Dim row As Integer
    Dim col As Integer
    Dim offset As Integer
    row = 2

    'Customize to your sheet name
    Set sheet = ThisWorkbook.Worksheets("Sheet1")

    'I am assuming there are no 'blanks' between rows or columns
    'If there are such 'blanks' use UsedRange.Rows or UsedRange.Columns
    'Then skip over the blanks with an if statement

    'Keep processing while we see data in the first column
    While (sheet.Cells(row, 1).Value <> "")
        'We only need to make a new row if anything past column C is filled out with something
        col = 4
        offset = 1
        While (sheet.Cells(row, col).Value <> "")
            'Insert new row
            sheet.Rows(row + offset).EntireRow.Insert shift:=xlDown

            'Assign Column values to the new row
            sheet.Cells(row + offset, 1).Value = sheet.Cells(row, 1).Value
            sheet.Cells(row + offset, 2).Value = sheet.Cells(row, 2).Value
            sheet.Cells(row + offset, 3).Value = sheet.Cells(row, col).Value

            'Remove Column value from the source row
            sheet.Cells(row, col).Value = ""

            col = col + 1
            offset = offset + 1
        Wend
        row = row + 1
    Wend
End Sub

Answer 3

我猜3a3n代码是公司特定的。 假设ABC1231位于Sheet1的B1中，插入新的Row1并应用此处详述的技术，在“ 3的第2b步”中选择Range为B1：到数据末尾。 进入表格后，您可以进行过滤以选择和删除列Value空白的行。

在B2中输入：

=INDEX(Sheet3!A:A,MATCH(A4,Sheet3!B:B,0))  

选择并复制表格，然后粘贴特殊...，将值放在顶部，并切换列A和B的顺序。