删除 600k 行需要 4 个多小时 [重复]

Question

下面的代码需要 4 个多小时才能从我的工作簿中删除 600,000 行。我需要我的代码花费更少的时间来删除相同数量的数据。

Sub Loop_Example()
    Dim Firstrow As Long, Lastrow As Long, Lrow As Long
    Dim CalcMode As Long, ViewMode As Long
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    With ActiveSheet
        .Select 'select sheet so we can change the window view
        ViewMode = ActiveWindow.View 'go to normal view, for speed
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False 'Turn off Page Breaks
        Firstrow = .UsedRange.Cells(1).Row  'Set first & last row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For Lrow = Lastrow To Firstrow Step -1  'loop bottom to top
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    Select Case .Value
                        Case Is <> "jelle", "ron", "dave": .EntireRow.Delete
                    End Select
                End If
            End With
        Next Lrow
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

Answer 1

尝试在循环期间构建一个范围（使用Union），然后在循环之后一次删除该范围内的所有行。未经测试，但类似：

Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        Dim rowsToDelete As Range

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

            'We check the values in the A column in this example
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    Select Case .Value
                        Case Is <> "jelle", "ron", "dave"
                        If Not (rowsToDelete Is Nothing) Then
                            Set rowsToDelete = Application.Union(rowsToDelete, .EntireRow)
                        Else
                            Set rowsToDelete = .EntireRow
                        End If
                    End Select
                End If
            End With
        Next Lrow
    End With

    rowsToDelete.EntireRow.Delete

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

为了加快速度，可以做的另一件事是将 A 列（您正在检查/比较的）中的单元格读入一个数组——然后循环遍历数组本身，而不是进行 600k 次调用到工作表。在遍历数组时，您将使用Union 构建一个范围，然后在最后一次调用中删除该范围。