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

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

1 个答案: