VBA supprimer toute les cellules ne contenant pas

[atl61]

Bonjour
Je recherche le code vba pour supprimer toute les cellules de la colonne A ne commençant pas par "Ad." ou "Nr."
Pour l'instant j'ai fait ça mais et ça plante et j'ai l'impression de me prendre la tête pour rien en fait.

Sub NETTOYAGE()

Dim plage As Range, c As Range
'Plage de recherche ici A1 à Derniere cellule utilisée de colonne A
Set plage = Range("A1" & ":A" & Range("A65000").End(xlUp).Row)

'Pour chaque cellule de la plage de recherche
For Each c In plage
'je met dans une variable les 3 premiers caractères de la cellule
vval = Left(c.Value, 3)
'Si vval = total alors j'efface la ligne entiere
If vval = "Ad." Then
If vval = "Nr." Then
Else: c.EntireRow.Delete
Next c

End Sub
-----

[vande545]

Bonjour
Ayant quitté l'univers Micro$oft, je ne peux pas tester ton code.
Je me demande si le fait de supprimer une ligne n’altère pas la variable plage d'où le plantage ?

Quand j'avais besoin de nettoyer une feuille XL, je procédais autrement.
Je commençais par la fin de la feuille avec un do while sur le n° de ligne

(tant que le n° est supérieur à 1...
second do while tant que test cellule est vrai
détruire
loop
remonter d'une ligne
loop
)
Je sais bien que c'est beaucoup plus lent mais ça marchait.

[umfred]

je pense que tu y es presque:
tu veux supprimer la ligne entière ? si c'est pour supprimer le contenu de la cellule, c.clear

Sub NETTOYAGE()

Dim plage As Range
Dim i As Long
Dim vval As String
'Plage de recherche ici A1 à Derniere cellule utilisée de colonne A
Set plage = Range("A:A")

'Pour chaque cellule de la plage de recherche
For i = 0 To plage.Rows.Count
    'je met dans une variable les 3 premiers caractères de la cellule
    vval = Left(plage.Offset(i, 0).Value, 3)
    If vval = "" Then Exit For 'on sort du For si la ligne est vide (on suppose qu'il n'y a pas de lignes vides dans la plage à vider
    'Si vval = total alors j'efface la ligne entiere
    ' on utilise StrComp avec vbTextCompare pour ne pas tenir compte de la case (minuscules/majuscules)
    If StrComp(vval, "Ad.", vbTextCompare) <> 0 And StrComp(vval, "Nr.", vbTextCompare) <> 0 Then
        plage.Offset(i, 0).EntireRow.Delete
        i = i - 1 'comme on a supprimé une ligne(les lignes ont "remontées"), il faut décrémenter i
    End If
Next c

End Sub

[Ikhar84]

Je n'ai pas le temps de regarder le code (censé être en visio là ), mais comme le fait remarquer Vande, si on supprime une ligne, le nombre de ligne change... et donc leur réferences... logique...

Quand on prévoit de supprimer des lignes d'un élément, il est plus prudent de commencer par les dernières ligne de cet élément... (que ce soit une feuille excel ou les barreaux de l'échelle sur laquelle on se trouve...) !

[A voir en vidéo sur Futura]

[umfred]

je pense que tu y es presque:
tu veux supprimer la ligne entière ? si c'est pour supprimer le contenu de la cellule, c.clear

Sub NETTOYAGE()

Dim plage As Range
Dim i As Long
Dim vval As String
'Plage de recherche ici A1 à Derniere cellule utilisée de colonne A
Set plage = Range("A:A")

'Pour chaque cellule de la plage de recherche
For i = 0 To plage.Rows.Count
    'je met dans une variable les 3 premiers caractères de la cellule
    vval = Left(plage.Offset(i, 0).Value, 3)
    If vval = "" Then Exit For 'on sort du For si la ligne est vide (on suppose qu'il n'y a pas de lignes vides dans la plage à vider
    'Si vval = total alors j'efface la ligne entiere
    ' on utilise StrComp avec vbTextCompare pour ne pas tenir compte de la case (minuscules/majuscules)
    If StrComp(vval, "Ad.", vbTextCompare) <> 0 And StrComp(vval, "Nr.", vbTextCompare) <> 0 Then
        plage.Offset(i, 0).EntireRow.Delete
        i = i - 1 'comme on a supprimé une ligne(les lignes ont "remontées"), il faut décrémenter i
    End If
Next c

End Sub

j'ai fais une erreur dans mon code, n'en tiens pas compte

[umfred]

ça devrait mieux fonctionner maintenant désolé

Sub NETTOYAGE()

Dim plage As Range
Dim i As Long
Dim vval As String
'Plage de recherche ici A1 à Derniere cellule utilisée de colonne A
Set plage = Range("A1" & ":A" & Range("A65000").End(xlUp).Row) 'Range("A:A")

'Pour chaque cellule de la plage de recherche
For i = plage.Rows.Count To 1 Step -1
    'je met dans une variable les 3 premiers caractères de la cellule
    vval = Left(plage.Cells(i, 1).Value, 3)
    'Si vval = total alors j'efface la ligne entiere
    ' on utilise StrComp avec vbTextCompare pour ne pas tenir compte de la case (minuscules/majuscules)
    If StrComp(vval, "Ad.", vbTextCompare) <> 0 And StrComp(vval, "Nr.", vbTextCompare) <> 0 Then
        plage.Cells(i, 1).EntireRow.Delete
    End If
Next i

End Sub

[atl61]

Merci pour le retour c'est super!
j'avais trouvé une solution beaucoup plus archaïque.

[umfred]

archaïque comment ?

[atl61]

Du bricolage

Sub SupLigne()
Columns("A").Replace _
What:="Ad.Crt", Replacement:="! Ad.Crt", _
SearchOrder:=xlByColumns, MatchCase:=True

Columns("A").Replace _
What:="Nr. Série", Replacement:="! Nr. Série", _
SearchOrder:=xlByColumns, MatchCase:=True

Dim plage As Range, c As Range
'Plage de recherche ici A1 à Derniere cellule utilisée de colonne A
Set plage = Range("A1" & ":A" & Range("A65000").End(xlUp).Row)

'Pour chaque cellule de la plage de recherche
For Each c In plage
'je met dans une variable les 2 premiers caractères de la cellule
vval = Left(c.Value, 2)
'Si vval = total alors j'efface la ligne entiere
If vval <> "! " Then c.EntireRow.Delete
Next c

For Each c In plage
'je met dans une variable les 20 premiers caractères de la cellule
bal = Left(c.Value, 20)
'Si vval = total alors j'efface la ligne entiere
If bal = "Points de l'Esserbus" Then c.EntireRow.Delete
Next c

Columns("A").Replace _
What:="! Ad.Crt", Replacement:="Ad.Crt", _
SearchOrder:=xlByColumns, MatchCase:=True

Columns("A").Replace _
What:="! Nr. Série", Replacement:="Nr. Série", _
SearchOrder:=xlByColumns, MatchCase:=True

Honteux non!?

[umfred]

tu dois avoir un souci de saut de ligne parfois, non ? comme l'ont fait remarqué Vande545 et Ikhar84 (sauf si les lignes étaient regroupées)

[atl61]

en faite je récupére des programations en format Pdf
actuellement je suis obligé de tout retranscrire (avec les erreurs qui peuvent se glisser dedans )pour mon utilisation.
Mais la je cherche à automatiser la chose car c'est un taf qui été occasionnel mais que je me retrouve à faire de plus en plus souvent
Et oui les textes sont regroupé mais vu que je fais un copier coller depuis le pdf je me retrouve avec les pieds de page à supprimer.

[umfred]

Sinon en fait, par rapport à ton premier code, l'erreur venait du test que tu faisais

If vval = "Ad." Then
If vval = "Nr." Then

tu testais d'abord si c'était égal à "Ad." et si c'était le cas, tu testais si c'était égal à "Nr."; ce qui ne pouvait jamais être le cas.
il aurait fallu l'écrire

if vval="Ad." or vval="Nr." then