宏可根据条件将不同行中的单元格复制到1行中，并删除剩余的空白/移位单元格

Question

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

如果列A项不是1，则我需要同一行中的所有数据。data_sheet列A上标有1的所有内容表示应将行中的单元格复制到output_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