宏將數據從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的順序。