如果找到子字符串，如何加快此代码查找和删除行的速度

Question

下面的代码按预期工作得很好，唯一的缺点是它很慢，因为我使用它来搜索子字符串的所有实例并删除整个工作簿的任何单元格中的整行。

目标很简单，如果在任何单元格字符串中找到输入的字符串，只需删除整行

Dim wo As Worksheet, ws As Worksheet
Dim I As Long, j As Long, m As Long
Dim toFind As String, testStr As String
Dim pos As Long
Dim lstRow As Long, cutRow As Long
Dim WS_Count As Integer
Dim Cell As Range

Option Compare Text
Option Explicit

Sub SearchDelete()

toFind = InputBox("Enter the substring you want to search for.", "Welcome", "AAAA")
toFind = Trim(toFind)
j = 0

If toFind = "" Then
    MsgBox "Empty String Entered.Exiting Sub Now."
    Exit Sub
Else
        WS_Count = ActiveWorkbook.Worksheets.Count

        'Begin the loop.
        For I = 1 To WS_Count

Label1:
                For Each Cell In Worksheets(I).UsedRange.Cells

                    If Trim(Cell.Text) <> "" Then
                        pos = 0
                        pos = InStr(1, Trim(Cell.Text), toFind, vbTextCompare)

                        If pos > 0 Then     'match Found'

                            cutRow = Cell.Row
                            Worksheets(I).Rows(cutRow).EntireRow.Delete
                            j = j + 1
                           GoTo Label1
                        Else: End If

                    Else: End If

                Next Cell
         Next I
End If

MsgBox "Total " & j & " Rows were deleted!"

End Sub

Answer 1

单个操作几乎总是比批量操作慢，Range.Delete method 也不例外。使用 Union method 收集匹配的行，然后执行删除 en masse 将显着加快操作速度。

暂时挂起某些应用程序环境处理程序也会有所帮助。删除行时不需要激活Application.ScreenUpdating；仅在您完成操作后。

Option Explicit
Option Compare Text

Sub searchDelete()
    Dim n As Long, w As Long
    Dim toFind As String, addr As String
    Dim fnd As Range, rng As Range

    toFind = InputBox("Enter the substring you want to search for.", "Welcome", "AAAA")
    toFind = Trim(toFind)

    If Not CBool(Len(toFind)) Then
        MsgBox "Empty String Entered.Exiting Sub Now."
        GoTo bm_Safe_Exit
    End If

    'appTGGL bTGGL:=False   'uncomment this line when you have finsihed debugging

    With ActiveWorkbook
        For w = 1 To .Worksheets.Count
            With .Worksheets(w)
                Set fnd = .Cells.Find(what:=toFind, lookat:=xlPart, _
                            after:=.Cells.SpecialCells(xlCellTypeLastCell))
                If Not fnd Is Nothing Then
                    Set rng = .Rows(fnd.Row)
                    n = n + 1
                    addr = fnd.Address
                    Do
                        If Intersect(fnd, rng) Is Nothing Then
                            n = n + 1
                            Set rng = Union(rng, .Rows(fnd.Row))
                        End If
                        Set fnd = .Cells.FindNext(after:=fnd)
                    Loop Until addr = fnd.Address
                    Debug.Print rng.Address(0, 0)
                    rng.Rows.EntireRow.Delete
                End If
            End With
        Next w
    End With

    Debug.Print "Total " & n & " rows were deleted!"

bm_Safe_Exit:
    appTGGL

End Sub

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

Answer 2

您的问题的答案："How to speed up this code to find and delete rows if a substring is found" 是 - 不要在找到并删除该行后从工作表顶部重复搜索！