Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 suppression de ligne si condition (vba)

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Karim48

XLDnaute Nouveau
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.
 

Pièces jointes

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 :
VB:
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

Code:
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.
 
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 :
VB:
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
 

Pièces jointes

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é...
VB:
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
761
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…