我有一个For Each循环，用于查找包含带通配符的字符串且该字符串不是粗体的单元格。如果满足这些条件，则删除该单元格的行。我相信For Each循环效率不高，即使只有200行左右，代码也需要花费几秒钟来运行。有没有更有效的方法来获得这些结果？
Dim Cell As Range
Dim sheetRange As Range
Set sheetRange = ActiveSheet.UsedRange
For Each Cell In sheetRange
Set Cell = sheetRange.Find(What:="Total*", lookat:=xlPart)
If Not Cell Is Nothing Then
If Cell.Font.Bold = False Then
Cell.EntireRow.Delete
End If
End If
Next Cell
请查看下面的代码，看看是否可以将其适应特定的用例。该DeleteTotalRows子例程使用内置.Find方法来专门跳转到包含值“总计”的单元格。它将每个这些单元格传递到MergeDeleteRange子例程。此子项将建立一个要删除的范围，其中包含具有单词和粗体字的所有行。
如果遇到问题，请向后报告。
Option Explicit
Sub DeleteTotalRows()
Dim fnd As Range
Dim rngToDelete As Range
Dim firstFnd As Range
Dim sht As Worksheet
'Update this
Set sht = Worksheets("Sheet2")
With sht
Set fnd = .Cells.Find(what:="Total", lookat:=xlPart)
If fnd Is Nothing Then Exit Sub
Set firstFnd = fnd
Do
MergeDeleteRange rngToDelete, fnd
Set fnd = .Cells.Find(what:="Total", lookat:=xlPart, after:=fnd)
Loop While fnd.Address <> firstFnd.Address
End With
If rngToDelete Is Nothing Then Exit Sub
rngToDelete.Delete
End Sub
Private Sub MergeDeleteRange(ByRef outputRng As Range, ByRef inputCell As Range)
'Not deleting if the cell isn't bold
If Not inputCell.Font.Bold Then Exit Sub
'Create output range if it's still empty
If outputRng Is Nothing Then Set outputRng = inputCell.EntireRow
'Since you are testing multiple columns, confirm that the
'row isn't already in the output range
If Not Intersect(inputCell, outputRng) Is Nothing Then
Exit Sub
End If
Set outputRng = Union(outputRng, inputCell.EntireRow)
End Sub
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句