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

Question

我想删除仅在 O 列中包含“Resigned”一词的所有行。
这是我下面处理的代码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

删除数十万条条件行

如果条件列未排序，它将永远存在。

假设数据采用表格格式，即在具有一行标题的连续范围内(没有空行或空列)。

此解决方案将插入一个具有升序整数序列的辅助列。然后它将按条件列对范围进行排序，对其进行过滤，删除关键行(它们现在在一个连续的范围内)，最后按帮助列排序并删除。

在我的机器上，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