如果我有大约十万行，如何更换LOOP

我有macros工作良好，但它的超级慢，见下文。 基本上是这样做的，就是macros遍历F列中的每一行，而不是删除行。

所以我可以怎样更快地取代我的循环？

非常感谢，并致以良好的祝愿。

Sub Delete2_Find() Dim rgFoundCell As Range Application.ScreenUpdating = False With Sheets("Raw Data") Set rgFoundCell = .Range("F:F").Find(what:=Month(Now) - 2) Do Until rgFoundCell Is Nothing rgFoundCell.EntireRow.Delete Set rgFoundCell = .Range("F:F").FindNext Loop End With Application.ScreenUpdating = True MsgBox "DONE!" End Sub 

Answer 1

你能结合范围，并立即删除它 ？ 这可以帮助吗？ 像这样的东西：

 Option Explicit Sub Delete2_Find() Dim rgFoundCell As Range Dim toBeDeted As Range Dim firstAddress Application.ScreenUpdating = False With Sheets("Raw Data").Range("F:F") Set rgFoundCell = .Find(what:=Month(Now) - 2) If Not rgFoundCell Is Nothing Then firstAddress = rgFoundCell.Address Do If toBeDeted Is Nothing Then Set toBeDeted = rgFoundCell.EntireRow Else Set toBeDeted = Union(toBeDeted, rgFoundCell.EntireRow) End If Set rgFoundCell = .FindNext(rgFoundCell) If rgFoundCell Is Nothing Then Exit Do Loop While rgFoundCell.Address <> firstAddress End If End With Application.ScreenUpdating = True If Not toBeDeted Is Nothing Then _ toBeDeted.Select ' Delete MsgBox "DONE!" End Sub