删除没有满足特定条件的循环的行

Question

我正在编写一个宏，该宏会从我使用公式找到的值中删除小于 0.75 的所有行。在另一个线程中，在这里，我发现了一个有效的循环，但这需要很长时间才能运行......所以我试图找到一种没有循环的方法。到目前为止，我的代码如下所示，但我在行上得到“运行时错误 1004，方法'对象工作表范围'失败”

ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Select

有人对更正有任何想法吗？感谢所有帮助

Private Sub CommandButton6_Click()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim i&, lr&, rowsToDelete$, lookFor$, lookFor2$

'*!!!* set the condition for row deletion
lookFor = "#VALUE!"
lookFor2 = "0.75"

Set ws = ThisWorkbook.Sheets("Entry")
lr = ws.Range("H" & Rows.Count).End(xlUp).row

ReDim arr(0)

For i = 1 To lr
 If StrComp(CStr(ws.Range("H" & i).Text), lookFor, vbTextCompare) = 0 Or _
    CDbl(ws.Range("H" & i).Value) < CDbl(lookFor2) Then
    ReDim Preserve arr(UBound(arr) + 1)
    arr(UBound(arr) - 1) = i
 End If
Next i

If UBound(arr) > 0 Then
    ReDim Preserve arr(UBound(arr) - 1)
    For i = LBound(arr) To UBound(arr)
        rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
    Next i

    ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Select
    Selection.Delete Shift:=xlUp

    lr = ws.Range("A" & Rows.Count).End(xlUp).row
    ws.Range(lr & ":" & lr).Select
Else
    Application.ScreenUpdating = True
    MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
    Exit Sub
End If

If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Set ws = Nothing
End Sub

Answer 1

这是一种方法：

Sub Macro1()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

    Dim r As Range

    Set r = Sheet1.UsedRange

    r.AutoFilter Field:=8, Criteria1:="<.75", _
        Operator:=xlAnd
    r.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    r.AutoFilter

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With

End Sub

这假设 H 列（或上面代码中的 8 列）包含您要过滤的值。您必须进行调整以适合您的床单。