Supprimer des lignes "conditions"

eillon

XLDnaute Junior
Voir exemple.

Lorsque je tris par code postal, je supprimes tous les départements qui ne me concerne pas pour les livraisons.
Je vous fais parvenir les départements que je veux conserver.

Il faudrait que toutes les lignes qui ne correspondent pas aux départements soient supprimer.

En clair si j'ai un code postal 83570 (colonne E) en ligne 175, supprimer ligne 175.

Liste des départements que je dois conserver :

02
08
10
14
18
21
22
27
28
29
35
36
37
41
44
45
49
50
51
52
53
54
55
56
57
58
59
60
61
62
67
68
70
72
75
76
77
78
79
80
85
86
88
89
90
91
92
93
94
95

Merci.
 

Pièces jointes

  • Exemple.xls
    13.5 KB · Affichages: 79
  • Exemple.xls
    13.5 KB · Affichages: 74
  • Exemple.xls
    13.5 KB · Affichages: 75

Staple1600

XLDnaute Barbatruc
Re : Supprimer des lignes "conditions"

Re


Il manquait une ligne (j'ai édite TestIII)

edit: dernière modif en cours
Code:
Sub testIV()
Dim cell As Range
Dim derlig As Long
'identifie la dernière ligne de ta colonne E
derlig = Range("E65536").End(xlUp).Row
'désactive l'actualisation de l'écran
Application.ScreenUpdating = False
'dans toutes les cellules de la plage 
For Each cell In Range("E2:E" & derlig)
'Left=gauche  Len= Nombre de caractères  --> NBCAR en formule
Select Case Left(cell.Value, Len(cell))
Case 11000 To 11999, 12000 To 12999, 13000 To 13999, _
15000 To 15999, 16000 To 16999, 17000 To 17999, 19000 To 19999, 20000 To 20999, 23000 To 23999, 26000 To 26999, _
30000 To 30999, 34000 To 34999, 38000 To 38999, 39000 To 39999, 40000 To 40999, 42000 To 42999, 43000 To 43999, _
46000 To 46999, 48000 To 48999, 63000 To 63999, 66000 To 66999, 69000 To 69999, 71000 To 71999, 74000 To 74999, _
81000 To 81999, 84000 To 84999, 87000 To 87999
cell.EntireRow.Delete
Case 1000 To 7999
cell.EntireRow.Delete
End Select
Next
End Sub
 
Dernière édition:

eillon

XLDnaute Junior
Re : Supprimer des lignes "conditions"

Je suis désolé, c'est un peu long, mais c'est toujours pareil, il m'en supprime 2 ou 3 et il faut que je relance pour les autres.

Code:
Sub testIV()
Dim cell As Range
Dim derlig As Long
'identifie la dernière ligne de ta colonne E
derlig = Range("E65536").End(xlUp).Row
'désactive l'actualisation de l'écran
Application.ScreenUpdating = False
'dans toutes les cellules de la plage
For Each cell In Range("E2:E" & derlig)
'Left=gauche  Len= Nombre de caractères  --> NBCAR en formule
Select Case Left(cell.Value, Len(cell))
Case 11000 To 11999, 12000 To 12999, 13000 To 13999, _
15000 To 15999, 16000 To 16999, 17000 To 17999, 19000 To 19999, 20000 To 20999, 23000 To 23999, 26000 To 26999, _
30000 To 30999, 34000 To 34999, 38000 To 38999, 39000 To 39999, 40000 To 40999, 42000 To 42999, 43000 To 43999, _
46000 To 46999, 48000 To 48999, 63000 To 63999, 66000 To 66999, 69000 To 69999, 71000 To 71999, 74000 To 74999, _
81000 To 81999, 84000 To 84999, 87000 To 87999
 cell.EntireRow.Delete
Case 1000 To 1999, 3000 To 7999, 9000 To 9999
cell.EntireRow.Delete
End Select
Next
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Supprimer des lignes "conditions"

Re

Je séche toujours
Code:
Sub testV()
Dim cell As Range
Dim derlig As Long
derlig = Range("E65536").End(xlUp).Row
Application.ScreenUpdating = False
If Not IsEmpty(cell) Then
For Each cell In Range("E2:E" & derlig)
Select Case Left(cell.Value, Len(cell))
Case 11000 To 13999, _
15000 To 17999, 19000 To 20999, 23000 To 23999, 26000 To 26999, _
30000 To 30999, 34000 To 34999, 38000 To 40999, 42000 To 43999, _
46000 To 46999, 48000 To 48999, 63000 To 63999, 66000 To 66999, _
69000 To 69999, 71000 To 71999, 74000 To 74999, _
81000 To 81999, 84000 To 84999, 87000 To 87999
cell.EntireRow.Delete
Case 1000 To 7999
cell.EntireRow.Delete
End Select
Next
End If
End Sub
 

eillon

XLDnaute Junior
Re : Supprimer des lignes "conditions"

Toujours pareil, sur 364 lignes j'en rajoute 10 mauvaises, il faut que je lance la macro 5 fois pour qu'il fasse le ménage, je ne comprends pas qu'il ne les reconnaisse pas tous du premier coup.

J'ai trois fichier répartis pour des livraisons sur toute la France, un sur Paris, un sur Toulouse, un sur Lyon.
Certains clients apparaissent dans le mauvais fichiers, jusqu'à maintenant, on supprime manuellement en cherchant les codes postaux qui ne nous intéressent pas.

On est en progrès avec cette macro mais si tout pouvais se faire en une fois...
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Supprimer des lignes "conditions"

Bonjour Eillon, Stapple

Si je peux me permettre, je pense qu'il faut plutôt utiliser une boucle "for" et non "for each", ce qui permet de commencer par la fin, toujours plus adéquat lorsque l'on supprime des lignes.

bon après midi
@+
 

Pierrot93

XLDnaute Barbatruc
Re : Supprimer des lignes "conditions"

Re

ma solution, via un tableau, liste des départements à compléter :

Code:
Sub test()
Dim i As Integer, monchoix(), x As Byte
monchoix = Array("02*", "08*", "10*", "14*", "18*", "21*", "22*", "27*", "28*", "29*")
For i = Range("E1:E" & Range("E65536").End(xlUp).Row).Rows.Count To 2 Step -1
    For x = LBound(monchoix) To UBound(monchoix)
        If Cells(i, 5).Text Like monchoix(x) Then GoTo suite
    Next x
    Cells(i, 5).EntireRow.Delete
suite:
Next i
End Sub

@+
 

Staple1600

XLDnaute Barbatruc
Re : Supprimer des lignes "conditions"

Re

merci Pierrot93

J'ai du mal comprendre
Code:
Sub testVI()
Dim i As Long
Application.ScreenUpdating = False
If Not IsEmpty(cell) Then
For i = Range("E1:E" & Range("E65536").End(xlUp).Row).Rows.Count To 2 Step -1
Select Case Left(Cells(i, 5).Value, Len(Cells(i, 5)))
Case 11000 To 13999, _
15000 To 17999, 19000 To 20999, 23000 To 23999, 26000 To 26999, _
30000 To 30999, 34000 To 34999, 38000 To 40999, 42000 To 43999, _
46000 To 46999, 48000 To 48999, 63000 To 63999, 66000 To 66999, _
69000 To 69999, 71000 To 71999, 74000 To 74999, _
81000 To 81999, 84000 To 84999, 87000 To 87999
Cells(i, 5).EntireRow.Delete
Case 1000 To 7999
Cells(i, 5).EntireRow.Delete
End Select
Next i
End If
End Sub

Ou est mon erreur, stp?
 

eillon

XLDnaute Junior
Re : Supprimer des lignes "conditions"

En rouge. "variable non définie"

Code:
Sub testVI()
Dim i As Long
Application.ScreenUpdating = False
If Not IsEmpty([COLOR="Red"]cell[/COLOR]) Then
For i = Range("E1:E" & Range("E65536").End(xlUp).Row).Rows.Count To 2 Step -1
Select Case Left(Cells(i, 5).Value, Len(Cells(i, 5)))
Case 11000 To 13999, _
15000 To 17999, 19000 To 20999, 23000 To 23999, 26000 To 26999, _
30000 To 30999, 34000 To 34999, 38000 To 40999, 42000 To 43999, _
46000 To 46999, 48000 To 48999, 63000 To 63999, 66000 To 66999, _
69000 To 69999, 71000 To 71999, 74000 To 74999, _
81000 To 81999, 84000 To 84999, 87000 To 87999
Cells(i, 5).EntireRow.Delete
Case 1000 To 7999
Cells(i, 5).EntireRow.Delete
End Select
Next i
End If
End Sub