删除 O 列中包含特定单词的所有行的最佳代码？

Question

我想删除仅在 O 列中包含“已辞职”一词的所有行。

下面是我的代码，用于处理 331,000+ 行。这是最有效或最快速的方法吗？

Sub Delete Resigned ()

Dim i as Integer

For i = Range("O" & Rows.Count).End(xlUp).Row To 1 Step -1
   If Instr(1, Cells(i, 3), "Resigned") <> 0 Then
      Cells(i,3).EntireRow.Delete
   End If
Next i

End Sub

提前感谢社区！

Answer 1

删除数十万个条件行

如果条件列未排序，则需要很长时间。
假定数据采用 table 格式，即在连续范围内（没有空行或空列），其中一行为 headers。
此解决方案将插入一个具有升序整数序列的辅助列。然后它将按条件列对范围进行排序，对其进行过滤，删除关键行（它们现在处于连续范围内），最后按并删除辅助列进行排序。
在我的机器上，1M 行和 26 列以及大约 350k 匹配行用了不到 30 秒。非常欢迎您对其效率的反馈。

Sub DeleteResigned()
    
    Dim dt As Double: dt = Timer
    
    Const FirstCriteriaCellAddress As String = "O1"
    Const Criteria As String = "Resigned"

    Application.ScreenUpdating = False

    ' Reference the worksheet and remove any filters.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.FilterMode Then ws.ShowAllData
    
    ' Reference the range.
    Dim fCell As Range: Set fCell = ws.Range(FirstCriteriaCellAddress)
    Dim rg As Range: Set rg = fCell.CurrentRegion
    
    ' Calculate the column index.
    Dim cIndex As Long: cIndex = fCell.Column - rg.Column + 1
    
    With rg.Columns(cIndex)
        ' Check if any criteria.
        If Application.CountIf(.Resize(.Rows.Count - 1).Offset(1), Criteria) _
                = 0 Then
            Application.ScreenUpdating = True
            MsgBox "No criteria found", vbExclamation
            Exit Sub
        End If
        ' Insert a helper column containing an ascending integer sequence.
        .Insert xlShiftToRight, xlFormatFromRightOrBelow
        With .Offset(, -1)
            .NumberFormat = 0
            .Value = ws.Evaluate("ROW(" & .Address & ")")
        End With
    End With
    
    ' Sort the range by the criteria column.
    rg.Sort rg.Columns(cIndex + 1), xlAscending, , , , , , xlYes
    
    ' Reference the data range (no headers).
    Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    ' Filter the data of the criteria column.
    rg.AutoFilter cIndex + 1, Criteria
    
    ' Reference the visible data rows of the filtered range and delete them.
    Dim vdrg As Range: Set vdrg = drg.SpecialCells(xlCellTypeVisible)
    ws.AutoFilterMode = False
    vdrg.Delete xlShiftUp
    
    ' Sort by and delete the helper column.
    rg.Sort rg.Columns(cIndex), xlAscending, , , , , , xlYes
    rg.Columns(cIndex).Delete xlShiftToLeft
    
    Application.ScreenUpdating = True
    
    Debug.Print Timer - dt

    MsgBox "Rows deleted.", vbInformation
    
End Sub

删除 O 列中包含特定单词的所有行的最佳代码？

Best code to delete all rows containing a specific word in column O?

excel

vba

删除数十万个条件行