SUPPRIMER LIGNES TABLEAU EN VBA EN PASSANT PAR UN FILTRE

[Charles78]

Bonjour,

Je souhaite supprimer des lignes d'un tableau à partir de la ligne 2 si la cellule en colonne H contient OUI (à savoir que le OUI est obtenu suite à une formule). Quand je me retrouve avec des lignes dont la cellule en colonne H contient OUI et d'autres contiennent NON, cela fonctionne car ça supprime bien toutes les lignes dont la cellule en colonne H contenait OUI et je me retrouve bien qu'avec les lignes dont les cellules en colonne H contiennent NON. Idem si je me retrouve avec que des lignes dont la cellule en colonne H contient NON, ça fonctionne aussi car ça ne me supprime pas les lignes.

En revanche, si je me retrouve qu'avec des lignes dont la cellule en colonne H contient OUI, les lignes ne sont pas supprimées et c'est bien là le problème.

Ci-dessous mon code:

 For i = Range("A65536").End(xlUp).Row To 2 Step -1
            If Cells(i, 8) Like "*OUI*" Then Rows(i).Delete
        Next i

Aussi, je pense que pour être plus rapide je souhaiterais un code VBA (avec la syntaxe If Then Else) qui indique la condition suivante: Si "toute" la Colonne C à partir de la ligne 2 (donc ne pas prendre en compte l'en-tête) a ses cellules vides, alors il faut supprimer toutes les lignes du tableau. Je ne vois pas comment je peux formuler ce code étant débutant en VBA (j'insiste bien sur le fait que toutes les cellules de la colonne C doivent être vides).

Merci beaucoup pour votre aide.

 

[fanfan38]

Bonjour
Un fichier exemple est TOUJOURS le bienvenu...
Ci joint ma solution...
A+ François

 

[Staple1600]

Bonjour le fil, Charles78, fanfan38

Une autre méthode (sans filtre, sans boucle)

Sub SupprLignes()
Dim dl&: dl = Cells(Rows.Count, 1).End(3).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
  With Cells(2, Columns.Count).Resize(dl - 1)
    .Formula = "=IF(H2=""OUI"",""$"",0)"
    .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
    .Clear
  End With
Application.Calculation = xlCalculationAutomatic
End Sub

NB: Test OK sur mon propre fichier exemple (avec mes propres formules qui renvoient OUI en colonne H)

 

[Charles78]

Bonjour
Un fichier exemple est TOUJOURS le bienvenu...
Ci joint ma solution...
A+ François

Bonjour Fanfan, merci pour le fichier mais quand je l'ouvre je ne retrouve pas le code. Y-a-t-il eu un problème quand vous l'avez uploadé ?

Merci.

 

[Staple1600]

Re

Charles78
Et le code du message#3?
Tu l'as testé?

 

[Charles78]

Bonjour le fil, Charles78, fanfan38

Une autre méthode (sans filtre, sans boucle)

Sub SupprLignes()
Dim dl&: dl = Cells(Rows.Count, 1).End(3).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
  With Cells(2, Columns.Count).Resize(dl - 1)
    .Formula = "=IF(H2=""OUI"",""$"",0)"
    .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
    .Clear
  End With
Application.Calculation = xlCalculationAutomatic
End Sub

NB: Test OK sur mon propre fichier exemple (avec mes propres formules qui renvoient OUI en colonne H)

Bonjour Staple,

Merci également. Je vais tester votre code et vous tiens au courant.

Merci.

 

[fanfan38]

Le code est sur la feuil1
Cliquer sur le nom de la feuille avec le bouton droit de la souris
cliquer sur visualiser le code...
A+ François

 

[Staple1600]

Bonjour à toi aussi fanfan38...

(cf message#3)

 

[fanfan38]

Bonjour Staple 1600
J'ai une erreur avec ta solution à la ligne
With Cells(2, Columns.Count).Resize(dl - 1)
A+ François

 

[Staple1600]

Re

fanfan38
Pas d'erreur chez moi
(mais comme précisé j'ai testé sur mon propre fichier test, vu que le demandeur n'en a point fourni )

 

[Staple1600]

Re

Voilà sur quoi j'ai testé
Sur une feuille vierge, lancer la macro ci-dessous

Sub CréationTEST()
Application.ScreenUpdating = False
Range("A1") = "=""ITEM_""&COLUMN()"
Range("A1:P1").FillRight
Range("A2:P30") = "=ADDRESS(ROW(),COLUMN(),4)"
Range("A2:P30") = Range("A2:P30").Value
Range("H2:H30").FormulaR1C1 = "=IF(MOD(RIGHT(RC[-4])*1,5)=0,""OUI"",""NON"")"
End Sub

Tu as une erreur chez toi quand tu lances SupprLignes ?
Moi, non
(Test sur Excel 2013)

 

[Charles78]

Re

Charles78
Et le code du message#3?
Tu l'as testé?

Donc je l'ai testé mais j'ai un message d'erreur sur la ligne:

With Cells(2, Columns.Count).Resize(dl - 1)

Merci.

 

[Charles78]

Je n'arrive pas à joindre mon fichier (on m'indique qu'il est trop volumineux mais je vais réessayer).

 

[Staple1600]

Re

Faire le test avec le code du message#11
(A exécuter sur une feuille vierge)
Puis quand l'exemple est créé
Lancer la macro SupprLignes
Normalement pas de message d'erreur, et les lignes avec OUI ont été supprimées.

En tout cas, c'est ce qui se passe sur mon PC.

PS: On ne joint pas le fichier original mais un fichier allégé pour illustrer la question
Ou comme je l'ai fait une macro qui créé l'exemple

 

[Charles78]

Le code est sur la feuil1
Cliquer sur le nom de la feuille avec le bouton droit de la souris
cliquer sur visualiser le code...
A+ François

Fanfan,

Ta solution fonctionne ! Merci beaucoup !!!

Merci.