根据条件删除整行无法处理 400,000 行

我有这个宏来删除那些不是“chr9”的整行。我总共有 401,094 行。它似乎编译得很好，但我的 Excel 冻结了，我必须强制退出。

我认为这可能是一个低效的算法或者代码中的一些错误？

Sub deleteNonChr9()
    Dim lastrow As Long
    Dim firstrow As Long
    Dim i As Long

    lastrow = 401094
    firstrow = 0

    ' Increment bottom of sheet to upwards
    For i = lastrow To firstrow Step -1
        If (Range("C1").Offset(i, 0) <> "chr9") Then
            Range("C1").Offset(i, 0).EntireRow.Delete
        End If
    Next i

End Sub

有条件删除行的最快方法是将它们全部放在数据块的底部。将它们排序到该位置并删除比单独循环甚至编译不连续的要快Union https://msdn.microsoft.com/en-us/library/office/ff834621.aspx要删除的行数。

当任何组或单元格是连续的（即全部在一起）时，Excel 不必费力地删除它们。如果它们位于底部Worksheet.UsedRange 属性 https://msdn.microsoft.com/en-us/library/office/ff840732.aspx，Excel 不必计算用什么来填充空白区域。

您的原始代码不允许在第 1 行中使用列标题文本标签，但我会解释这一点。如果您没有的话，请修改以适应。

这些将关闭计算能力的三个主要寄生虫。其中两个已经在评论和答案中得到解决，第三个Application.EnableEvents 属性 https://msdn.microsoft.com/en-us/library/office/ff821508.aspx无论您是否有事件驱动的例程，都可以对 Sub 过程的效率做出有效的贡献。有关详细信息，请参阅底部的辅助 Sub 过程。

样本数据²：A:Z 中的 500K 行随机数据。 〜33%Chr9在 C:C 列中。要删除大约 333K 随机不连续行。

Union https://msdn.microsoft.com/en-us/library/office/ff834621.aspx并删除

Option Explicit

Sub deleteByUnion()
    Dim rw As Long, dels As Range

    On Error GoTo bm_Safe_Exit
    appTGGL bTGGL:=False          'disable parasitic environment

    With Worksheets("Sheet1")
        Set dels = .Cells(.Rows.Count, "C").End(xlUp).Offset(1)
        For rw = .Cells(.Rows.Count, "C").End(xlUp).Row To 2 Step -1
            If LCase$(.Cells(rw, "C").Value2) <> "chr9" Then
                Set dels = Union(dels, .Cells(rw, "C"))
            End If
        Next rw
        If Not dels Is Nothing Then
            dels.EntireRow.Delete
        End If
    End With

bm_Safe_Exit:
    appTGGL

End Sub

^{Elapsed time: <It has been 20 minutes... I'll update this when it finishes...>}

从工作表批量加载到变体数组、更改、加载回来、排序和删除

Sub deleteByArrayAndSort()
    Dim v As Long, vals As Variant

    On Error GoTo bm_Safe_Exit
    appTGGL bTGGL:=False          'disable parasitic environment

    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion
            .EntireRow.Hidden = False
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
               'bulk load column C values
                vals = .Columns(3).Value2

               'change non-Chr9 values into vbNullStrings
                For v = LBound(vals, 1) To UBound(vals, 1)
                    If LCase$(vals(v, 1)) <> "chr9" Then _
                      vals(v, 1) = vbNullString
                Next v

            End With

           'dump revised array back into column C
            .Cells(2, "C").Resize(UBound(vals, 1), UBound(vals, 2)) = vals

            'sort all of blank C's to the bottom
            .Cells.Sort Key1:=.Columns(3), Order1:=xlAscending, _
                               Orientation:=xlTopToBottom, Header:=xlYes

            'delete non-Chr9 contiguous rows at bottom of currentregion
            .Range(.Cells(.Rows.Count, "C").End(xlUp), .Cells(.Rows.Count, "C")).EntireRow.Delete

        End With
        .UsedRange   'reset the last_cell property
    End With

bm_Safe_Exit:
    appTGGL

End Sub

^{Elapsed time: 11.61 seconds¹}
       _{(166,262 rows of data remaining²)}

原始代码

^{Elapsed time: <still waiting...>}

Summary

在变体数组中工作以及删除连续范围有明显的优点。我的示例数据有约 66% 的行需要删除，因此这是一项艰巨的任务。如果需要删除 5 或 20 行，使用数组解析数据进行排序可能不是最佳解决方案。您必须根据自己的数据做出自己的决定。

appTGGL 辅助子程序

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
    Debug.Print Timer
End Sub

¹ _{Environment: old business class laptop with a mobile i5 and 8gbs of DRAM running WIN7 and Office 2013 (version 15.0.4805.1001 MSO 15.0.4815.1000 32-bit) - typical of the low end of the scale for performing this level of procedure.}

² _{Sample data temporarily available at Deleting entire row cannot handle 400,000 rows.xlsb https://dl.dropboxusercontent.com/u/100009401/deleting%20entire%20row%20cannot%20handle%20400%2C000%20rows.xlsb.}