Microsoft 365 suppression de ligne si condition (vba)

[Karim48]

Bonjour,

Dans le fichier ci-joint, j'aimerais supprimer toutes les lignes ne contenant pas la valeur 3 en colonne Q. J'ai bien essayer cette formule mais elle ne fonctionne pas:

Sub EntireRow()
Dim I As Integer
For I = Range("Q" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(I, 17) = "" Then Cells(I, 1).EntireRow.Delete

Next I
End Sub

Merci par avance pour l'aide que vous pourrez m'apporter.

 

[sylvanu]

Bonjour Karim,

j'aimerais supprimer toutes les lignes ne contenant pas la valeur 3

Alors pourquoi testez vous si Q est vide ? Ou alors Q ne peut avoir que 3 ou vide ?
Testez :

If Cells(I, 17) <> 3 Then Cells(I, 1).EntireRow.Delete

et rajoutez un Application.ScreenUpdating = False pour figer l'écarn ça ira beaucoup plus vite

Sub EntireRow()
Application.ScreenUpdating = False
Dim I As Integer
     For I = Range("Q" & Rows.Count).End(xlUp).Row To 1 Step -1
             If Cells(I, 17) <> 3 Then Cells(I, 1).EntireRow.Delete
     Next I
End Sub

Si vous avez énormément de lignes il faut passer par un autre algo pour être plus rapide.

 

[sylvanu]

Re Karim, bonsoir Bruno,
@Karim, testez cette PJ avec la macro SuppLignes.
Sur mon vieux PC, XL2007, on passe de 3.35s avec votre macro à 0.13s. Avec :

Sub SuppLignes()
T0 = Timer  ' A supprimer, juste pour mesurer le temps
    Application.ScreenUpdating = False                  ' On fige l'écran
    DL = [Q65000].End(xlUp).Row                         ' Dernière ligne de Résultat
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion colonne en A
    f = "=SI(R2<>3;CAR(1);0)"                           ' Formule utilisée
    With Range("A2:A" & DL)                             ' Plage où coller la formule qui sera triée, dernière colonne qui peut toujours être utilisée XFD
        .FormulaLocal = f                               ' Coller formule
        .EntireRow.Sort .Cells, xlDescending            ' Tri pour regrouper et accélérer
        .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete  ' Suppression des lignes concernées
        .Delete Shift:=xlToLeft                         ' Effacement colonne formules
    End With
    Columns.AutoFit                                     'Ajustement largeurs colonnes
    With ActiveSheet.UsedRange: End With                'Ajustement barres de défilement
MsgBox Timer - T0  ' A supprimer
End Sub

 

[Dudu2]

Bonjour @Karim48, @sylvanu, @BrunoM45,

Perso, je préfèrerais mettre le code dans un module plutôt que dans la feuille.
Sinon, une autre possibilité...

Sub DeleteRows()
    Dim i As Long
    Dim RangeDelete As Range
  
    With ActiveSheet
        For i = .UsedRange.Row To .UsedRange.Row + .UsedRange.Rows.Count - 1
            If Cells(i, "Q") <> 3 Then
                If RangeDelete Is Nothing Then
                    Set RangeDelete = Rows(i)
                Else
                    Set RangeDelete = Union(RangeDelete, Rows(i))
                End If
            End If
        Next i
    End With
  
    If Not RangeDelete Is Nothing Then RangeDelete.Delete
End Sub

 

[sylvanu]

Bonjour @Karim48, @Dudu2 , @BrunoM45,
@dudu,
Mais écrite comme ça, la macro est plus lente qu'avec une version par formules.
En test j'obtiens sur la feuille de Karim :
Karim : 2.48s
Dudu : 0.25s
Sylvanu : 0.14s
Tout du moins avec XL2007 et VBA 6.3. Je ne sais pas si ça change avec les différentes versions.

 

[Dudu2]

@sylvanu,
Bien vu, complexe mais efficace.