si 3 derniers caract cell "A01" alors supp ligne

boby · 28 Août 2006

Bonjour à tous,

je commence à parler comme un vrai VBAiste, mais je n'en ai pas encore les compétences

je souhaiterai savoir s'il existe un code pour supprimer une ou des ligne entière si dans la colonne A ces lignes les 3 dernier caracteres de la celule sont:
- A01
- A02
- A03
- Z01
- Z02
- Z03

existe t il egalement un code pour supprimer plusieurs colonnes ou groupes de colonnes différents en meme temps

Merci a tous

Hervé · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

bonjour body, le forum

peut etre une macro dans ce style :

PHP:

Dim i As Long

For i = Range("a65536").End(xlUp).Row To 1 Step -1
    Select Case Right(Cells(i, 1), 3)
        Case "A01", "A02", "A03", "Z01", "Z02", "Z03"
            Rows(i).Delete
    End Select
Next i

salut

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Bonjour Hervé, le fil, le forum,

ton code me plait bien mais il ne fonctionne pas
je ne saurait pas te dire pourquoi
j'ai un tableau avec plusieurs colonnes
c'est la colonne A qui nous interesse
dans cette colonnes j'ai plein de references différentes et de differentes tailles
je souhaiterai supprimer les lignes dont les celules ont des references se terminant pas A01..........Z03

voila un peu plus de précision
merci

Hervé · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

re boby

ben...désolé, mais ce code fonctionne l'ayant préalablement testé.

pourrais-tu nous fournir un exemple de ce qui se trouve en colonne A.

salut

mutzik · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Bonjour Boby, Hervé,

tu peux nous joindre un bout de ton fichier, cela serait plus facile pour nous, car le code d'Hervé devrait fct sans prob, mais ... à voir avec ton fichier

Arffff, collision

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

voila un bout de ce que je fais au préalable pour supprimer les lignes et les colonnes que je ne veux pas garder
Sub R20AX_EOC_TEST()

Application.ScreenUpdating = False
Rows("1:3").Select
Selection.delete Shift:=xlUp
Range("A:B,E:G").Select
ActiveWindow.SmallScroll ToRight:=6
Range("A:B,E:G,K:K").Select
Selection.delete Shift:=xlToLeft
columns("H:I").Select
Selection.delete Shift:=xlToLeft
columns("I:M").Select
Selection.delete Shift:=xlToLeft
columns("J:K").Select
Selection.delete Shift:=xlToLeft
columns("K:M").Select
Selection.delete Shift:=xlToLeft
columns("L:U").Select
Selection.delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=-1

For i = Range("H65536").End(xlUp).Row To 2 Step -1
code = Left(Range("H" & i).Value, 2)
If code <> "AT" And code <> "CH" And code <> "DK" And code <> "FI" And code <> "IE" And code <> "JP" And code <> "MX" _
And code <> "NL" And code <> "PT" And code <> "XS" Then
Rows(i).delete Shift:=xlUp
End If
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If LCase(Cells(i, 4).Value) = "20920" Then Rows(i).delete
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If LCase(Cells(i, 4).Value) = "85068" Then Rows(i).delete
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Left(Range("A" & i).Value, 1) = "A" Then Rows(i).delete
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Left(Range("A" & i).Value, 1) = "E" Then Rows(i).delete
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Left(Range("A" & i).Value, 1) = "P" Then Rows(i).delete
Next i
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Left(Range("A" & i).Value, 1) = "0" Then Rows(i).delete
Next i

si vous connaissez un code plus simple et rapide pour faire ça je suis preneur car mois je ne fais que bricoler par ci par la

ensuite en colonne A on trouve ceci

Your reference

14426701Z01
14311416TTMO
14371815TTMO
14433563A01
14421237PVM
14437105A01
14437855TTMO
14437104A01
14426690Z01
14431887A02
14432199TTMO
14283986Z03
14283983Z02
14425091A02
14425091A02
14399414Z01
14432202TTMO
14424935A02
14432201TTMO
14432267A01
14216153Z02
14425097A01
14425086A01
14425080A01
14428126A01
14432561A01

merci du coup de pouce

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Oups

Voici Un Bout De Mon Fichier

Edition : j'ai supprimé le fichier joint celui-ci contenant des données confidentielles. Merci de mettre des données bidons.
Pascal

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Merci Pascal,

en effet ces données sont confidentielles

voici un autre fichier

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

oups je l'avais oublie
maintenant j'espere qu'il est attaché

porcinet82 · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Bonjour le fil,

Je viens de regarder ton fichier et tes données. Le code d'Hervé ne fonctionne pas car tes données dans la colonne A sont suivies d'espaces. Avec le code suivant, ca a l'air de fonctionner :

Code:

Sub test()
Dim i As Long
For i = Range("a65536").End(xlUp).Row To 3 Step -1
    Select Case Mid(Cells(i, 1).Value, InStr(1, Cells(i, 1).Value, " ") - 3, 3)
        Case "A01", "A02", "A03", "Z01", "Z02", "Z03"
            Rows(i).Delete
    End Select
Next i
End Sub

@+

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Bonjour à tous,

salut Porcinet;

decidement toi tu as toujours solution à tout
merci ton code marche plus que bien

aurais tu une façon d'ecrire ma macro de manière plus simple parceque moi je met des "If" partout

merci Porcinet

merci à tous

myDearFriend! · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Bonjour boby, Hervé, mutzik, porcinet82, le Forum,

En complément,

Si le tableau original contient un grand nombre de lignes, ci-dessous une modification du code VBA qui devient un peu plus long dans l'éditeur mais plus rapide à l'exécution :

Code:

[SIZE=2]Sub Test()
[COLOR=navy]Dim [/COLOR]Plage[COLOR=navy] As [/COLOR]Range
[COLOR=navy]Dim [/COLOR]i[COLOR=navy] As Long[/COLOR]
      [COLOR=navy]For [/COLOR]i = 2[COLOR=navy] To [/COLOR]Range("a65536").[COLOR=navy]End[/COLOR](xlUp).Row
            [COLOR=navy]Select Case[/COLOR] Right(RTrim(Cells(i, 1).Value), 3)
                  [COLOR=navy]Case[/COLOR] "A01", "A02", "A03", "Z01", "Z02", "Z03"
                        [COLOR=navy]If [/COLOR]Plage[COLOR=navy] Is Nothing Then[/COLOR]
                              [COLOR=navy]Set[/COLOR] Plage = Rows(i)
                        [COLOR=navy]Else[/COLOR]
                              [COLOR=navy]Set[/COLOR] Plage = Union(Plage, Rows(i))
                        [COLOR=navy]End If[/COLOR]
            [COLOR=navy]End Select[/COLOR]
      [COLOR=navy]Next[/COLOR] i
      [COLOR=navy]If Not [/COLOR]Plage[COLOR=navy] Is Nothing Then[/COLOR] Plage.Delete
[COLOR=navy]End[/COLOR] Sub[/SIZE]

Cordialement,

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

bonjour à tous,

Porcinet,

ton code ne fonctionne pas pour ce fichier alors qu'il a fonctionné pour le tableau précedent

myDearFriend,

ton code fonctionne tout seul mais lorsque je le rajoute à ma macro
il y a une erreur qui se produit en "Dim i As Long"

y a t il un moyen pour que cela fonctionne sur tous mes tableaux?

merci à tous

boby · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

Porcinet,

le bug se produit en :
Select Case Mid(Cells(i, 1).Value, InStr(1, Cells(i, 1).Value, " ") - 3, 3)

merci

Hervé · 28 Août 2006

Re : si 3 derniers caract cell "A01" alors supp ligne

bonjour tout le monde

UNION

Un jour viendra ou je penserai à cette syntaxe qui doit en effet etre bien plus rapide et elegante.

merci didier

boby, pour ta simplification de code regarde le code de didier à l'aide des select case.

salut

si 3 derniers caract cell "A01" alors supp ligne

boby

Guest

Hervé

XLDnaute Barbatruc

boby

Guest

Hervé

XLDnaute Barbatruc

mutzik

XLDnaute Barbatruc

boby

Guest

boby

Guest

boby

Guest

boby

Guest

Pièces jointes

porcinet82

XLDnaute Barbatruc

boby

Guest

myDearFriend!

XLDnaute Barbatruc

boby

Guest

boby

Guest

Hervé

XLDnaute Barbatruc

Discussions similaires

si 3 derniers caract cell "A01" alors supp ligne

boby

Guest

Hervé

XLDnaute Barbatruc

boby

Guest

Hervé

XLDnaute Barbatruc

mutzik

XLDnaute Barbatruc

boby

Guest

boby

Guest

boby

Guest

boby

Guest

Pièces jointes

porcinet82

XLDnaute Barbatruc

boby

Guest

myDearFriend!

XLDnaute Barbatruc

boby

Guest

boby

Guest

Hervé

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency