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

Question

我有这个宏来删除那些不是“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

Answer 1

有条件删除行的最快方法是将它们全部放在数据 block 的底部。将它们排序到该位置并删除比单独循环甚至编译不连续的 Union 更快要删除的行数。

当任何组或单元格是连续的(即全部在一起)时，Excel 不必费力地删除它们。如果它们位于 Worksheet.UsedRange property 的底部，Excel 不必计算用什么来填充空白区域。

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

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

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

<强> Union并删除

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...>}

摘要

在变体数组中工作以及删除连续范围有明显的优点。我的示例数据有约 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

---

1 _{环境:老式商务级笔记本电脑，配备移动 i5 和 8GB DRAM，运行 WIN7 和 Office 2013(版本 15.0.4805.1001 MSO 15.0.4815.1000 32 位) - 典型的低端执行规模这个级别的程序。}

² _{样本数据暂时可在Deleting entire row cannot handle 400,000 rows.xlsb获取.}