Question

我正在尝试创建一个按钮宏，根据'b'列中的true / false值删除行。删除的问题是一旦它消失了，'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的行，则可以使用以下代码。我测试它，它工作正常。它将删除所有行UP（包括）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

除非你需要行中的所有数据，否则我建议使用这个;或者您也可以将这些行中的其他数据添加到循环中。哪个还会快得多

根据单元格值删除多行，删除滞后

2 个答案:

工作代码