根据条件将不同行中的单元格复制到 1 行并删除空白/向左移动单元格的宏

Question

我对宏的了解仅限于记录步骤，我还没有学会如何编写/编辑代码。我需要帮助编写一个宏，该宏将根据第一列的值从某一行复制单元格并粘贴到新选项卡，然后删除空白/向左移动单元格，并将数据从下一行复制到最后一个条目后的下一个单元格传输的第一组数据。

如果 A 列条目不是 1，我需要同一行中的所有数据。data_sheet 的 A 列上标记为 1 的任何内容都表示应将行中的单元格复制到 output_sheet 中的新行

从此（data_sheet）：http://prntscr.com/348w2b

对此（output_sheet）：http://prntscr.com/348w4k

我可以手动执行此操作，但我正在处理超过 10 万行

任何帮助将不胜感激！

谢谢！

Answer 1

试试这个，最初活动表是您的数据网格：

Sub ReArrangeSheet()

Dim yCounter As Long, xCounter As Long
Dim LastCol As Long, LastRow As Long
Dim OutRow As Long, ColCounter As Long
Dim OutSheet As Worksheet, DataSheet As Worksheet

'name the active sheet so we can reference it easily
ActiveSheet.Name = "Data"
Set DataSheet = Worksheets("Data")

'find the last row and and last col to identify the ends
'of our loops
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'create an output worksheet
Worksheets.Add(After:=Worksheets(1)).Name = "Output"
Set OutSheet = Worksheets("Output")

'start looping through the checker column
OutRow = 0
For yCounter = 2 To LastRow

    If DataSheet.Cells(yCounter, 1) = 1 Then 'start new row on output sheet
        OutRow = OutRow + 1
        ColCounter = 1 'initialize ColCounter everytime a new row starts
    End If

    'start looping through data grid
    For xCounter = 2 To LastCol

        If DataSheet.Cells(yCounter, xCounter) <> "" Then 'write to output sheet
            OutSheet.Cells(OutRow, ColCounter) = DataSheet.Cells(yCounter, xCounter)
            ColCounter = ColCounter + 1
        End If

    Next xCounter

Next yCounter

End Sub