根據列中的值刪除行

Question

我有以下代碼可以工作，即當特定列的值為“PAID”時刪除工作表中的一行

Sub RemoveRows()

Dim i As Long
Dim strtest As String

i = 1

Do While i <= ThisWorkbook.ActiveSheet.Range("AG1").CurrentRegion.Rows.Count

strtest = ThisWorkbook.ActiveSheet.Cells(i, 33).Text
    If ThisWorkbook.ActiveSheet.Cells(i, 33).Text = "PAID" Then
        ThisWorkbook.ActiveSheet.Cells(i, 33).EntireRow.Delete
    Else
        i = i + 1
    End If

Loop

End Sub

但是，它在 5000 行的工作表上非常慢。

任何想法如何使它更快？

Answer 1

有多種原因可能會影響代碼執行速度，包括編碼方法/方法。 請參閱下面帶有注釋的修訂代碼。

Sub RemoveRowsV2()

Dim i As Long
Dim strtest As String
Dim rngDel As Range

i = 1

'\\ Control features which may affect code processing!
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Do While i <= ThisWorkbook.ActiveSheet.Range("AG1").CurrentRegion.Rows.Count
    '\\ Build a union of all cells to be deleted
    strtest = ThisWorkbook.ActiveSheet.Cells(i, 33).Value
    If ThisWorkbook.ActiveSheet.Cells(i, 33).Value = "PAID" Then
        If rngDel Is Nothing Then 
            Set rngDel = ThisWorkbook.ActiveSheet.Cells(i, 33)
        Else
            Set rngDel = Union(rngDel, ThisWorkbook.ActiveSheet.Cells(i, 33))
        End If
    Else
        i = i + 1
    End If

Loop
'\\ Delete them once
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

'\\ Reset features which may affect code processing!
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


End Sub

或者，您可以使用宏記錄器根據@BigBen 建議的自動過濾器獲取主要代碼！

Answer 2

您可以嘗試以下幾件事：

• 在循環中的某個點添加語句“Do Events”。 這個“DoEvents 是一個 Excel VBA 命令，它臨時暫停宏的執行以刷新屏幕並在 Excel 中執行任何掛起的事件。” 例如：

   Do
       ' code execution... 

        DoEvents

    Loop Until rowB = "" Or rowB11 = ""

• 在循環之前，您可以添加語句“Application.ScreenUpdating = False”。 這將關閉您在處理過程中看到的工作表的刷新閃爍。

    Application.ScreenUpdating = False