根據單元格值刪除多行，消除滯后

Question

我正在嘗試創建一個按鈕宏，該宏基於'b'列中的真/假值刪除行。 刪除的問題是，一旦刪除，“ for _ do”將跳過以下內容，原因是波紋管范圍內的單元格成為當前單元格。 我想出了這個替代方案，但是大量完成時卻顯得太遲了。 有什么建議么。 另外，我試圖保持代碼盡可能的簡潔和整潔，我不喜歡太多的變量，因為將來在我不得不進行檢查和調整時，它會造成混亂。 感謝名單

Dim inps As Integer

Sub delline()
inps = MsgBox("Are you sure you wish to delete the selected rows?", vbYesNo, "Point Of No Return")
If inps = vbYes Then
 For Each b In Range("B12", Range("B12").End(xlDown))
  For Each a In Range("B12", Range("B12").End(xlDown))
    If a.Value = True Then
     a.EntireRow.Delete
    End If
   Next a
  Next b
End If
End Sub

Answer 1

從最后刪除到第一個。 for RowIndex = RowIndexMax to RowIndexMin Step -1

工作代碼

Sub delline() 'Using Max-Min-Rows

    Const RowIndexMin  As Long = 12 'first row at the top. B12 => row 12.
    Const ColumnB_Index As Long = 2

    Dim UserDecision As Long
    Dim RowIndexMax  As Long 'last row at the bottom
    Dim RowIndex  As Long 'changed in every loop

    On Error GoTo Reset

    UserDecision = MsgBox("Are you sure you wish to delete the selected rows?", vbYesNo + vbQuestion, "Point Of No Return") 'you can combine vb- enumerations ;)
    If UserDecision <> vbYes Then
        Exit Sub 'just my way of avoiding unnecessary nesting.
    End If

    'Some of speet boosting settings
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    RowIndexMax = Cells(RowIndexMin, ColumnB_Index).End(xlDown).Row

    For RowIndex = RowIndexMax To RowIndexMin Step -1 'Step -1 decreases the RowIndex every loop by 1
        If Cells(RowIndex, ColumnB_Index).Value2 = True Then
            Debug.Print "Deleting row: " & RowIndex
            Rows(RowIndex).Delete
        End If
    Next

    'True's should be gone. Falses should bubbled to the top.
Reset:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic 'assuming it was automatic at the beginning
    Application.ScreenUpdating = True
End Sub

Answer 2

在代碼中，應將Application.ScreenUpdating設置為False ，這會對性能產生巨大影響，但一定要在完成后將其設置為True ！

Sub delline()

    Application.ScreenUpdating = False

    If (MsgBox("Are you sure you wish to delete the selected rows?", _ 
                vbYesNo, "Point Of No Return") = vbYes) Then
        For Each b In Range("B12", Range("B12").End(xlDown))
            For Each a In Range("B12", Range("B12").End(xlDown))
                If a.Value = True Then
                    a.EntireRow.Delete
                End If
            Next a
        Next b
    End If

    Application.ScreenUpdating = True

End Sub

編輯

如果您要做的只是嚴格刪除B列中值為= FALSE的行，則可以使用以下代碼。 我已經對其進行了測試，並且效果很好。 它將刪除直到（包括）B12的所有行

Sub test1()

    Dim LastRow As Long

    Application.ScreenUpdating = False
    If (MsgBox("Are you sure you wish to delete the selected rows?", _ 
            vbYesNo, "Point Of No Return") = vbYes) Then
        With ActiveSheet
            LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For i = LastRow To 12 Step -1
                If (.Cells(i, "B").Value = True) Then
                    .Cells(i, "B").EntireRow.Delete
                End If
            Next i
        End With
    End If
    Application.ScreenUpdating = True

End Sub

編輯2

這是使用直接值復制方法，與上述所有方法相比，它非常快

Sub test1()

    Dim LastRow As Long
    Dim LastRow2 As Long
    Application.ScreenUpdating = False

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = LastRow To 12 Step -1
            If (.Range("B" & i).Value = False) Then
                LastRow2 = Sheets("Sheet2").Cells(.Rows.Count, "B").End(xlUp).Row + 1
                Sheets("Sheet2").Range("B" & LastRow2).Value = .Range("B" & i).Value
               ' .Range("B" & i).EntireRow.Delete
            End If
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

除非您需要這些行中的所有數據，否則我建議您使用這一行。 或者，您也可以將這些行中的其他數據添加到循環中。 哪個仍然會更快