commment rechercher et supprimer des lignes

[laurent]

Bonjour à tous,

Je débute dans les macros et je me trouve coincé.

J'ai un fichier excel avec 200 lignes qui me servent à rien.
Dans la colonne A de ces lignes, il y a "PCI Dump".

J'aimerai faire une macro qui cherche les cellules contenant "PCI Dump" et supprime ces lignes.

Voici ma macro.

Dim cel As Object
Do
For Each cel In Range("A:A")
If cel.value = "PCI Dump" Then
cel.EntireRow.Delete
End If
Next cel
Loop Until cel.Value = ""
MsgBox "fini"

ça marche mais ça ne me supprime pas la totalité des lignes (obliger de relancer la macro pour supprimer le reste). je lance la macro ça me supprime une 100ène de lignes, la seconde fois une 50ène, puis 30, 10,...jusqu'à 0.
Au total, je doit lancer au moins 5 fois la macro pour ne plus avoir de ligne.

Qu'est ce qui ne va pas dans ma macro??

Merci d'avance

Laurent

 

[yeahou]

Bonjour Laurent, Gérard, Matt, Aziz Fall, le forum

Comme cela fait deux fois que la question est posée, voici deux codes plus performant. Les deux sont beaucoup plus rapides. Le premier limite les tests à la dernière ligne utilisée, le deuxième ne teste que les cellules A ou D non vides.

Cordialement, A+

'Code 1
Sub Supprimer_Lignes2()
Dim Compteur As Long

Application.ScreenUpdating = False

For Compteur = Range("A1").SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Range("A" & Compteur).Value = "PCI Dump" Or Range("D" & Compteur).Value = "519" Then
Rows(Compteur & ":" & Compteur).Delete
End If
Next Compteur
MsgBox "fini"
End Sub

'Code 2
Sub Supprimer_Lignes3()
Dim Tab_Cells As Variant, Tab_Rows As Variant
Dim Compteur As Long, Cel_en_Cours As Range

Application.ScreenUpdating = False

Set Tab_Cells = Range("A:A").SpecialCells(xlCellTypeConstants, 23)
ReDim Tab_Rows(1 To Tab_Cells.Count)
Compteur = Tab_Cells.Count
For Each Cel_en_Cours In Tab_Cells
Tab_Rows(Compteur) = Cel_en_Cours.Row
Compteur = Compteur - 1
Next Cel_en_Cours
For Compteur = 1 To Tab_Cells.Count
If Range("A" & Tab_Rows(Compteur)).Value = "PCI Dump" Then
Rows(Tab_Rows(Compteur) & ":" & Tab_Rows(Compteur)).Delete
End If
Next Compteur

Set Tab_Cells = Range("D").SpecialCells(xlCellTypeConstants, 23)
ReDim Tab_Rows(1 To Tab_Cells.Count)
Compteur = Tab_Cells.Count
For Each Cel_en_Cours In Tab_Cells
Tab_Rows(Compteur) = Cel_en_Cours.Row
Compteur = Compteur - 1
Next Cel_en_Cours
For Compteur = 1 To Tab_Cells.Count
If Range("D" & Tab_Rows(Compteur)).Value = "519" Then
Rows(Tab_Rows(Compteur) & ":" & Tab_Rows(Compteur)).Delete
End If
Next Compteur

MsgBox "fini"

End Sub

 

[yeahou]

Salut Phibou

Désolé, Phibou, je n'avais pas actualisé
interressant ton code mais ton tableau étant positionné uniquement sur la colonne A, il ne déplace que les valeurs de cellules en colonne A,il ne supprime pas les lignes sur une valeur en colonne A. Cela n'est pas vraiment la question posée.
Corrigé, ce sera une excellente solution rapide.

Cordialement, A+

 

[PhiBou]

Re le Fil, le Forum

Effectivement, je ne pensais qu'à la colonne A et pas aux autres

Autre suggestion :

Sub SupVal2()
Dim Mat As Variant
Dim k As Long
Dim Col, j As Integer
Dim Lig, i As Long
Dim Plage As String
Plage = ActiveSheet.UsedRange.Address
k = 1
Mat = Range(Plage)
Lig = UBound(Mat)
Col = ActiveSheet.UsedRange.Count / UBound(Mat)
For i = 1 To Lig
If Mat(i, 1) <> "PCI Dump" Then
For j = 1 To Col
Mat(k, j) = Mat(i, j)
Next j
k = k + 1
End If
Next i
Range(Plage) = Mat
Range("A" & k & Mid(Plage, InStr(1, Plage, ":"), Len(Plage))).Delete
End Sub

Bonne fin de journée

PhiBou

PS : J'en profite pour poser une petite question :

Je calcule le nombre de colonne de l'Array comme ceci :

Col = ActiveSheet.UsedRange.Count / UBound(Mat)

Y'a-t-il plus simple ? merci

 

[yeahou]

Bonjour Laurent, Phibou, le forum

excellente solution rapide, Laurent.
Un petit bémol cependant, elle est à réserver aux tableaux sans formules et sans formats différenciés car seules les valeurs sont transférées, à part cela c'est pas mal, je connaissais pas usedrange qui impose quand même une contrainte pour l'utiliser en tableau, il faut au moins une valeur quelconque dans la colonne A et dans une colonne >= à D (suppression si Dn=519, voir énoncé).

pour ton nombre de colonnes tu peux faire:
ActiveSheet.UsedRange.Columns.Count

pour ma part voici un code utilisant un tableau de valeur pour les comparaisons mais supprimant effectivement les lignes, c'est plus rapide que mes précédents codes et préserve formats et formules.

Cordialement, A+

Sub Supprimer_Lignes4()
Dim Tab_Cells As Variant, Tab_Row() As String
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long
Application.ScreenUpdating = False

Tab_Cells = ActiveSheet.Range("A1" & Range("A1").SpecialCells(xlCellTypeLastCell).Row).Value
Compteur = 0
For Compteur2 = 1 To UBound(Tab_Cells)
If Tab_Cells(Compteur2, 1) = "PCI Dump" Or Tab_Cells(Compteur2, 4) = "519" Then
Compteur = Compteur + 1
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = (Compteur2) & ":" & (Compteur2)
End If
Next Compteur2
For Compteur2 = Compteur To 1 Step -1
Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
MsgBox "fini"
End Sub

 

[Yeahou]

Bonjour à tous

scusi, mon précédent message était bien sur pour phibou

A+

 

[PhiBou]

Re,

Merci pour le : ActiveSheet.UsedRange.Columns.Count

Bien vu pour ton code, je note.

Bonne fin de journée

PhiBou

 

[Yeahou]

Bonjour Tout le monde

Dans la série encore plus rapide, ce code basé sur le précédent supprime les lignes contigues par groupe et gagne encore en rapidité, l'opération de suppression étant la plus lente.

A+

Sub Supprimer_Lignes5()

Dim Tab_Cells As Variant, Tab_Row() As String
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

Application.ScreenUpdating = False

With ActiveSheet
Tab_Cells = .Range("A1" & Range("A1").SpecialCells(xlCellTypeLastCell).Row).Value
Compteur = 0
Compteur3 = 65536
For Compteur2 = 1 To UBound(Tab_Cells)
If Tab_Cells(Compteur2, 1) = "PCI Dump" Or Tab_Cells(Compteur2, 4) = "519" Then
If Compteur3 < 65536 Then
Tab_Row(Compteur) = Compteur3 & ":" & Compteur2
Else
Compteur = Compteur + 1
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = Compteur2 & ":" & Compteur2
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
For Compteur2 = Compteur To 1 Step -1
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub

 

[JCA06]

Bonjour Yeahou,

Tout cela à l'air génial, mais j'apprécierai encore plus si je comprenais tout !

J'ai l'impression d'arriver à lire à peu près tout, mais je débute en macro et tout ceci ne me parait pas très clair.

Voici une liste non exhaustive de ce que j'ai du mal à comprendre :
- Comment fonctionnent tes variables Tab_Cells et Tab_Row() ?
- Comment utilises-tu SpecialCells(xlCellTypeLastCell) ? Je suis allé voir l'aide, mais je nage !

En fait, ma question est "pourrais-tu s'il-te-plaît me décrire comment cela fonctionne en langage plus clair ?".

Merci !

 

[PGPC]

Bonjour le Forum ,


la macro de Yeahou m'interrese et je voudrai pouvoir l'adapter à une de mes applications et je ne sais pas comment la modifier

Voila j'ai un tableau C3 : AO50
je voudrai que la macro lorsque je l'execute mefface toutes les lignes qui auraient pour résultat une valeur zeo dans la colonne G3:G150

JE VOUS REMERCIE

Bonne journée...

 

[JCA06]

Salut PGPC,

Je vais essayer, en laissant le soin à ceux qui sont bons de corriger :

Sub Supprimer_Lignes5()

Dim Tab_Cells As Variant, Tab_Row() As String
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

Application.ScreenUpdating = False

With ActiveSheet
Tab_Cells = .Range("C3:G" & Range("C3").SpecialCells (xlCellTypeLastCell).Row).Value ' Lignes modifiées : A1 devient C3 et D devient G
Compteur = 0
Compteur3 = 65536
For Compteur2 = 1 To UBound(Tab_Cells)
If Tab_Cells(Compteur2, 5).value = 0 Then 'Condition modifiée : le test se fait sur la 5è colonne du tableau (C:G)
If Compteur3 < 65536 Then
Tab_Row(Compteur) = Compteur3 & ":" & Compteur2
Else
Compteur = Compteur + 1
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = Compteur2 & ":" & Compteur2
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
For Compteur2 = Compteur To 1 Step -1
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("C3").Select 'Référence A1 devient C3
End With
MsgBox "fini"
End Sub

Attention : je rappelle que je n'ai pas tout compris à cette procédure !
Je compte sur l'indulgence des correcteurs !

 

[PGPC]

Salut le forum ,salut JCA06

Bon et bien merci , je vais attendre un peu pour tester ...


@+

 

[Yeahou]

Bonjour à tous

voici quelques réponses, en espérant être assez clair.

Cordialement, A+

pour JCA06

- Comment fonctionnent tes variables Tab_Cells et Tab_Row() ?
tab_cells est un variant utilisé en tableau de valeur
tab_cells=plage.value signifie passer les valeurs de cellules dans le tableau tab_cells, ne pas confondre avec une instruction set tab_cells=plage qui reviendrait à créer une référence à une plage de cellule, un tableau de valeurs est beaucoup plus léger et rapide à manipuler, ce tableau est dimensionné et utilisé pour tester les valeurs.
Tab_Row est un tableau de valeurs texte dans lequel je stocke les lignes ou cellules à supprimer aprés détection

- Comment utilises-tu SpecialCells(xlCellTypeLastCell) ?
Range("A1").SpecialCells(xlCellTypeLastCell) est l'équivalent VB de la fonction atteindre disponible dans outils, elle permet de récupérer l'adresse de la dernière cellule utilisée de la feuille, correspond en fait à la cellule résultant de la colonne la plus élevée utilisée et de la ligne la plus élevée utilisée.
.Range("A1" & Range("A1").SpecialCells(xlCellTypeLastCell).Row).Value
cette intruction veut dire en clair la plage partant de A1 à la dernière cellule possible dans la colonne D.

Pour Pgpc

Sub Supprimer_Lignes6()

Dim Tab_Cells As Variant, Tab_Row() As String
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

Application.ScreenUpdating = False

With ActiveSheet
'indiquer ici la plage de test
Tab_Cells = .Range("G3:G150").Value
Compteur = 0
Compteur3 = 65536
For Compteur2 = 1 To UBound(Tab_Cells)
'indiquer ici la valeur du test et la colonne du tableau, ici 1 car une seule colonne de test
If Tab_Cells(Compteur2, 1) = "0" Then
If Compteur3 < 65536 Then
'indiquer ici la plage à supprimer
Tab_Row(Compteur) = "C" & Compteur3 & ":" & "AO" & Compteur2
Else
Compteur = Compteur + 1
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = "C" & Compteur2 & ":" & "AO" & Compteur2
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
For Compteur2 = Compteur To 1 Step -1
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub

 

[Yeahou]

Re bonjour

pour pgcp
un petit bug sur le code précédent, comme le test commence à la ligne 3
il faut coordonner le tableau de lignes avec le tableau de valeurs. En attendant la nouvelle version plus polyvalente et documentée, celle la devrait fonctionner pour ton cas.

Sub Supprimer_Lignes6()

Dim Tab_Cells As Variant, Tab_Row() As String
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

Application.ScreenUpdating = False

With ActiveSheet
'indiquer ici la plage de test
Tab_Cells = .Range("G3:G150").Value
Compteur = 0
Compteur3 = 65536
For Compteur2 = 1 To UBound(Tab_Cells)
'indiquer ici la valeur du test et la colonne du tableau, ici 1 car une seule colonne de test
If Tab_Cells(Compteur2, 1) = "0" Then
If Compteur3 < 65536 Then
'indiquer ici la plage à supprimer
Tab_Row(Compteur) = "C" & (Compteur3+2) & ":" & "AO" & (Compteur2+2)
Else
Compteur = Compteur + 1
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = "C" & (Compteur2+2) & ":" & "AO" & (Compteur2+2)
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
For Compteur2 = Compteur To 1 Step -1
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub

 

[PGPC]

Le forum, Yeahou rebonjour ,

je viens de tester , les lignes se suppriment biens

le probleme est que j'ai
la somme de G3:G150 dans la cellule G151

Donc si par exemple avec ta macro j'efface 10 lignes de valeurs 0, la somme de la cellule G151 va se retrouver en G141 et mon tableau ne fonctionnera plus , en quelque sortes il faudrait que la macro me rajoute autant de lignes (avec les formules) qu'elle en suppriment jje ne sais pas si c'est clair pour vous ???

Merci

 

[Yeahou]

Re Bonjour à Tous

voici le code documenté et perfectionné pour des tableaux pouvant commencer à n'importe quelle ligne. Je l'ai mis également en pièce jointe, c'est plus simple avec les tabulations.

Cordialement, A+ Yeah!

Sub Supprimer_Lignes()

'définition des variables
Dim Tab_Cells As Variant, Tab_Row() As String, Mem_Row As Long
Dim Cellule_Debut As Range, Cellule_Fin
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False

With ActiveSheet
'indiquer ici la plage de test
'si je désire tester les cellules colonnes A et D sur 6000 lignes la plage sera range("A16000")
'la ligne suivante définit le début du tableau de valeurs pour test
Set Cellule_Debut = .Range("A1")
'la ligne suivante définit la fin du tableau de valeurs pour test
'la valeur actuelle correspond à la dernière cellule de la colonne D avec possibilité de valeur
Set Cellule_Fin = Range("D" & Range("A1").SpecialCells(xlCellTypeLastCell).Row)
'mémorise la ligne de début du tableau de valeurs
Mem_Row = Cellule_Debut.Row - 1
'passe les valeurs de cellules au tableau de valeurs
Tab_Cells = .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Value
'initialise les compteurs
Compteur = 0
Compteur3 = 65536
'boucle sur la longueur du tableau
For Compteur2 = LBound(Tab_Cells) To UBound(Tab_Cells)
'indiquer ici la valeur du test et les ou la colonne du tableau, ici 2 car colonnes de test sur A et D
If Tab_Cells(Compteur2, 1) = "PCI Dump" Or Tab_Cells(Compteur2, 4) = "519" Then
If Compteur3 < 65536 Then
'indiquer ici les colonnes à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur3 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
Else
'si première ligne en test ok ou ligne d'avant en test no ok, on incrémentre compteur
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Row(1 To Compteur) As String
'indiquer ici la plage à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur2 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
'on enregistre le numéro de première ligne test ok
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
'on efface les lignes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1

'pour test
'Application.ScreenUpdating = True
'.Range(Tab_Row(Compteur2)).Select
'MsgBox Tab_Row(Compteur2)

.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub