macros将x列的数据重新排列成x行，然后复制A行和B行的数据
在电子表格中，我的数据量相当大，排列不当。 目前的格式有一个公司，一个产品名称，以及之后列出的成分。 成分都有自己的列没有标题。 举例来说，我很抱歉，由于我在标记语言中很糟糕，所以我没有反映，列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
这是一个短的应该工作：
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中查看，然后创build新行以适应那里的项目数量。
这应该做的伎俩，我把我的许多假设在代码评论。
我的主要是在数据列之间没有差距。 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
我猜3a3n代码是公司特定的。 假设ABC1231位于Sheet1的B1中，插入一个新的Row1并应用此处详述的技术，在“3的步骤2b”中selectRange为B1：到数据的末尾。 当你到达表格时，你可以过滤select和删除列Value空白的行。
在B2中input：
=INDEX(Sheet3!A:A,MATCH(A4,Sheet3!B:B,0))
select并复制表格，然后selectselect性粘贴…，将数值放在顶部，然后切换列A和B的顺序。