Suppression de lignes sans boucle répondant à certains critères

Question

Je travaille sur l'écriture d'une macro qui supprime toutes les lignes inférieures à .75 d'une valeur trouvée à l'aide d'une formule. Dans un autre thread, ici, j'ai trouvé une boucle qui fonctionne, mais cela prend beaucoup de temps à courir ... alors j'essaie de trouver un moyen sans boucle. Jusqu'à présent, j'ai le code comme vu ci-dessous, mais je reçois un « erreur d'exécution 1004, la méthode « gamme de feuille de calcul de l'objet » a échoué » sur la ligne

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

Tout le monde a des idées sur une correction? Toute aide est appréciée

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

Voici une façon:

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 

Cela suppose que la colonne H (ou 8 dans le code ci-dessus) maintient la valeur que vous souhaitez filtrer. Vous devrez ajuster pour adapter votre feuille.