Question

我在电子表格中有相当多的数据，排列不当。目前的格式有公司，产品名称和之后列出的成分。所有成分都有自己的列，没有标题。例如，我道歉并未在下面反映，因为我对标记语言很糟糕，A列标记为制造商，B列标记为产品名称，C列标记为成分，但其余列未标记。

最终，我需要将数据移至新工作表，其中数据仅出现在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代码是公司特定的。假设{1}在Sheet1的B1中，插入一个新的Row1并应用详细here的技术，在“步骤2b of 3”中选择Range为B1：到数据末尾。当您到达表格时，您可以过滤以选择并删除列ABC1231中的空白行。

在B2中输入：

Value

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

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

3 个答案: