如果find子string，如何加快此代码查找和删除行

下面的代码工作效果很好，唯一的缺点是它的速度慢，因为我正在使用它来search子string的所有实例，并删除整个行，如果在整个工作簿的任何单元格中find。

目标很简单，只要在任何单元格string中findinput的string，就删除整行

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方法也不例外。 使用联合方法收集匹配的行，然后一并执行删除将大大加快操作。

暂时挂起某些应用程序环境处理程序也将有所帮助。 在删除行时，不需要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"是 – "How to speed up this code to find and delete rows if a substring is found" 不要在表单顶部重复search！