vba supprimer automatiquement toutes les lignes selon 2 critères

[perdinch]

bonjour,

j'ai un tableau à 10 colonnes ET 5000 lignes

J'aimerais supprimer par VBA automatiquement toutes les lignes selon 2 critères :
les cellules de la colonne D et E contiennent la valeur 0.

exemples:
D6 contient 0 et E6 contient 0 : la ligne est supprimée
D6 contient 1 et E6 contient 0 : ligne conservée
D6 contient 1 et E6 contient 0: ligne conservée

Je joins un fichier exemple.

Merci d'avance pour votre aide

perdinch

 

[Dranreb]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonjour
Par une boucle allant de la fin vers le début pour ne pas louper de ligne :

Sub SupprimerLignes()
Dim L As Long
For L = 5001 To 2 Step -1
   If Feuil1.Cells(L, 4).Value = 0 And Feuil1.Cells(L, 5).Value = 0 Then Feuil1.Rows(L).Delete
   Next L
End Sub

À+

 

[bond]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonjour,
Un bout de code qui devrai faire l'affaire...

Dim Ligne As Long
    ActiveCell.SpecialCells(xlLastCell).Select 'dernière cellule Fichier
    Range("A" & Selection.End(xlDown).Row).Select 'dernière cellule Excel colonne A
    Ligne = Selection.End(xlUp).Row 'dernière ligne remplie en colonne A
For Ligne = Ligne To 1 Step -1
    If Range("D" & Ligne).Value + Range("E" & Ligne).Value = 0 Then Rows(Ligne).Delete Shift:=xlUp
Next

Edit :
Doublé !
Salut Dranreb 😉

 

[perdinch]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Merci ca marche très bien.


perdinch

 

[mth]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

🙂 Bonjour à tous 🙂

Pas mieux bien sûr, mais je me suis juste amusée à fonctionner sans boucle, au cas où le fichier serait très long.

Option Explicit
Sub supprlignes()
Dim lig As Long
With Sheets("Feuil1")
lig = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("K2").FormulaR1C1 = "=IF(AND(RC[-7]=0,RC[-6]=0),TRUE,"""")"
    .Range("K2").Copy .Range("K2:K" & lig)
    On Error Resume Next
    With .Cells(lig, 1).SpecialCells(xlCellTypeFormulas, 4)
        .EntireRow.Delete
    End With
    .Columns("K:K").ClearContents
End With
End Sub

Bonne journée à tous 🙂

mth

 

[zouk02]

Re : vba supprimer automatiquement toutes les lignes selon 1 critère

Bonsoir mth - Bonsoir à toutes et à tous,

je voulais transformer la formule vba initiale
pour n avoir comme test ( =valeur à zéro) Pour les lignes du tableau -( test d' une seule colonne par ex : AP)
et simplement effacer la ligne (toute entière!)
(tableau de 19 000 lignes avec 47 colonnes)
deux jours sur la formule vba !
et toujours pas de de résultat positif

Pouvez vous me Donner Conseil SVP Merci par Avance

a+ zouk

formule de base
Option Explicit
Sub supprlignes()
Dim lig As Long
With Sheets("Feuil1")
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("K2").FormulaR1C1 = "=IF(AND(RC[-7]=0,RC[-6]=0),TRUE,"""")"
.Range("K2").Copy .Range("K2:K" & lig)
On Error Resume Next
With .Cells(lig, 1).SpecialCells(xlCellTypeFormulas, 4)
.EntireRow.Delete
End With
.Columns("K:K").ClearContents
End With
End Sub
par celle ci
Sub supplignes()
Dim lig As Long
'frais non du fichier
With Sheets("frais1")
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range ("ap2") & [lig].End(xlUp).Row
.Replace What:="0", Replacement:="", LookAt:=xlWhole
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With .Cells(lig, 1).SpecialCells(xlCellTypeFormulas, 4)
.EntireRow.Delete

End With
End Sub

depuis 2 jours dessus.!!!! mais rien ne marche !!!!!!!

 

[laetitia90]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

bonjour tous
comme je comprends??

Sub es()
  On Error Resume Next
  With Sheets("frais1")
  .[Ap:Ap].Replace What:="0", Replacement:="", LookAt:=xlWhole
  .[Ap:Ap].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End With
End Sub

 

[zouk02]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonjour Laeticia90 Bonjour à toutes et à tous,
super géant...! merci !
merci encore
Bonne journée
(moi elle commence bien grâce à la formule de laeticia90 !)

 

[zouk02]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonsoir A toutes et A tous,

je reviens vers vous car la formule ne donne rien avec 80 000 lignes!!! Sinon c' est bon pour maxi 20 000lignes!!!
Cela est il le résultat d'un trop grand nombre de calcul?
pouvez vous éclairer ma lanterne . ? Merci
Bon week A tous
Zouk
sub supp_lignes_zéro()
' code vba pour supp toutes les lignes A zéro pour la colonne "AP"
Sheets("frais1").Select
On Error Resume Next
With Sheets("frais1")
.[Ap:Ap].Replace What:="0", Replacement:="", LookAt:=xlWhole
.[Ap:Ap].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With

End Sub

 

[laetitia90]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

re tous
essai comme cela deja voir si marcher ..... apres on verra pour simplifier

Sub supp_lignes_zéro()
On Error Resume Next
With Sheets("frais1")
 .Range("ap60000:ap80000").Replace What:="0", Replacement:="", LookAt:=xlWhole
 .Range("ap60000:ap80000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 .Range("ap40000:ap60000").Replace What:="0", Replacement:="", LookAt:=xlWhole
 .Range("ap40000:ap60000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 .Range("ap20000:ap40000").Replace What:="0", Replacement:="", LookAt:=xlWhole
 .Range("ap20000:ap40000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 .Range("ap1:ap20000").Replace What:="0", Replacement:="", LookAt:=xlWhole
 .Range("ap1:ap20000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

 

[BOISGONTIER]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonjour,

0,5s pour 55.000 lignes
Ne modifie pas l'ordre des lignes

Suppression de lignes

JB

 

[zouk02]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

Bonsoir A Toutes et Tous,
merci encore pour vos réponses
mais j ai toujours le soucis pour la supprimer mes lignes avec un zéro dans la colonne Ao (47 colonnes avec parfois 80 000 lignes
le programme avec 0.5s fonctionne bien dans l exemple mais avec toutes mes colonnes cela n est pas la même chose !!
désolé de venir faire de la résistance !! lol !! sinon pour le moment je ruse avec un filtre excel !!!
Bonne soirée A Vous tous
Zouk

 

[laetitia90]

Re : vba supprimer automatiquement toutes les lignes selon 2 critères

re tous 🙂🙂
un peu surprise!!! que rien marche chez toi avec les codes donnes
une methode simple si la chronologie pas importante

Sub es()
 Dim r As Long, a
 r = Cells.Find("*", , , , xlByRows, xlPrevious).Row
 Range("A2" & ":au" & r).Sort Key1:=Range("ao2"), Order1:=xlDescending, Header:=xlGuess
 Set a = Range("ao2", Cells(Rows.Count, "ao").End(xlUp)).Find("0", LookIn:=xlValues, LookAt:=xlWhole)
 Range("A" & a.Row & ":au" & r).ClearContents
End Sub

si importante & que par exemple tu as une colonne de reference "date" entre autres on peut remettre dans un ordre defini
si pas de colonne on peut cree une colonne inter au depart puis la supprimer a la fin sans pb..
attention je considere que tu as seulement 47 colonnes