a l'attention de Pierrejean

[JJ]

Bonsoir PierreJean,
Bonsoir à tous,
je joins la macro que tu as écrite:

Sub test()
fin = Range('F1').End(xlDown).Row
For n = 1 To fin
If Cells(n, 6).Interior.ColorIndex = 3 Then
Rows(n).Copy Destination:=Rows(fin + 1)
Rows(n).Delete
End If
Next n
End Sub

Cette macro copie en bas de tableau puis supprime les lignes dont la colonne 6 est rouge (code 3)

Quand j'ai lancé la macro avec mon fichier, je me suis aperçu qu'elle laissait des lignes avec des cellules rouges éparpillées dans le fichier? (alors que le petit fichier de test fonctionnait)

J'ai compris que l'erreur se produisait quand 2 (ou plus) lignes avec des cellules rouges se 'touchaient', la ligne déplacée et supprimée semble ne pas être testée.

La macro fonctionne parfaitement si les lignes 'rouges' ne se touchent pas (une au dessus ou dessous de l'autre)

Que faudrait il rajouter à la macro pour éviter ces' oublis' ?

merci et bonne soirée
JJ

 

[porcinet82]

Salut JJ,

Comme tu peux le constater, je ne suis pas pierrejean, mais bon je me permet de te repondre, et je pense qu'il ne m'en voudra pas.

Deux possibilité s'offre a toi, soit tu modifies comme ceci:

Sub test()
Dim fin As Integer, n As Integer
fin = Range('A1').End(xlDown).Row
For n = 1 To fin Step 1
    If Cells(n, 1).Interior.ColorIndex = 3 Then
        Rows(n).Copy Destination:=Rows(fin + 1)
        Rows(n).Delete
        n = n - 1
    End If
Next n
End Sub

Soit tu mets (et c'est ce qui est mieux) :

Sub test_v2()
Dim fin As Integer, n As Integer
fin = Range('A1').End(xlDown).Row
For n = fin To 1 Step -1
    If Cells(n, 1).Interior.ColorIndex = 3 Then
        Rows(n).Copy Destination:=Rows(fin + 1)
        Rows(n).Delete
        n = n - 1
    End If
Next n
End Sub

@+

 

[pierrejean]

bonsoir JJ bonsoir porcinet

je ne t'en veux absolument pas porcinet

JJ je te propose quelque chose qui n'est pas tres elegant mais qui je crois fonctionne
(je continue a potasser le probleme qui se complique car a chaque effacement de ligne il ya modification des numeros de ligne)

Sub test()
Dim tablo()
Dim tab1 As Integer

fin = Range('F1').End(xlDown).Row
For n = 1 To fin
If Cells(n, 6).Interior.ColorIndex = 3 Then
Rows(n).Copy Destination:=Rows(fin + 1 + tab1)
ReDim Preserve tablo(tab1 + 1)
tablo(tab1 + 1) = n
tab1 = tab1 + 1
End If
Next
b = 1
For n = 1 To tab1
If n = 1 Then
Rows(tablo(n)).Delete
Else
Rows(tablo(n) - b).Delete
b = b + 1
End If
Next

End Sub

 

[JJ]

Merci Porcinet82,
Dans le If Cells c'est 6 car col 6, pour le reste je rajoute donc n=n-1
Pourquoi c'est preferable :
fin to 1 step-1 que 1 To fin step 1 ?
merci
Bonne soirée

 

[pierrejean]

veux-tu essayer cela qui a le merite d'etre un peu plus concis

Sub test1()
fin = Range('F1').End(xlDown).Row
For n = fin To 1 Step -1
If Cells(n, 6).Interior.ColorIndex = 3 Then
Rows(n).Copy Destination:=Rows(fin + 1)
Rows(n).Delete
End If
Next n
End Sub

 

[porcinet82]

re JJ, salut pierrejean,

Excuse moi JJ, c'est vrai que c'est cells(n,6), c'est que j'ai tester sur la colonne 1, donc j'avais remplacer.

La deuxième solution est préférable car tu pars d'en bas et tu remontes, ce qui est plus logique lorsque tu supprimes des lignes, ca évite de faire un retour dans la boucle.

@+

PS : Pierrejean, tu prends des cours avec Hervé pour les tableau??? Moi je ne me sens pas le courage de m'y mettre, pourtant je pense que ca pourrait m'etre utilise de temps en temps.

Eidtion: je vois qu'on vient de se croiser, ta macro est identique a celle que j'ai proposée ci-dessus

Message édité par: porcinet82, à: 15/02/2006 18:47

 

[pierrejean]

@ porcinet

oui j'essaie d'utiliser les tableaux mais pour ce qui est de l'elegance je me traine loin derriere Herve (slurp sur les bottes)

chez moi ton second code a laissé une ligne et je n'ais pas testé le premier

j'ais bien sur adopté le step -1

edit:

je viens de tester ton premier code et j'ais du faire usage du ctrl pause

Message édité par: pierrejean, à: 15/02/2006 18:54

 

[JJ]

Bonsoir PierreJean
Je ne vois pas de difference entre cette macro et la première que tu as faite?
Dois je rajouter n=n-1 ou utiliser celle qui est moins élégante... ??
Merci a vous 2 et bonne soirée
JJ

 

[pierrejean]

la difference est dans le fait que l'on attaque la feuille par le bas et lorsque l'on supprime une ligne ce sont celles qui ont deja été traitées qui se decalent
j'ais mis

for fin to 1 step -1
au lieu de
for 1 to fin

teste bien sur des copies de ton fichier

 

[JJ]

Bonsoir , petite question supplémentaire, car j'ai quelques lignes vierges dans mon tableau que je ne veux pas supprimer, puis je écrire ceci dans ta macro:

Sub test1()
fin = Range('F1').End(xlDown).Row
For n = fin To 1 Step -1
If Cells(n, 6).Interior.ColorIndex = 3 Then
Rows(n).Copy Destination:=Rows(fin + 1)
Rows(n).Delete
n = n - 1
Else
If Cells(n, 6).Value = ' ' Then
n = n + 1
End If
Next n
End Sub

Merci
JJ

 

[PascalXLD]

Bonjour

Je t'invite JJ, comme Gerard l'a déjà fait je crois, à lire la charte et à l'appliquer

En effet on ne fait pas une question en apostrophant un membre du forum et de plus le titre doit être explicite donc on fait comment pour une recherche avec un titre comme le tien

 

[pierrejean]

precise s'il te plait
en effet en principe on ne supprime pas de ligne (elles sont transférées en bas de tableau)
ces lignes (de couleur) doivent rester en place si elles sont vides ??

ps: je viens de regaerder un peu
en fait une cellule rouge et vide seme la panique
en effet
fin = Range('F1').End(xlDown).Row
donne le numero de ligne de la derniere cellule vide de la colonne F

Pour le moment je ne vois pas comment traiter le problème

Message édité par: pierrejean, à: 16/02/2006 10:02

 

[porcinet82]

Bonjou a tous,

JJ, je pense qu'avec un petit exemple de ton fichir, ce serai plus clair. En effet, tu dis avoir des lignes vides, mais sont-elles colorés en rouges?

Comme la deja dis pierrejean, donne plus d'informations. Lorsque l'on post, il faut penser que les autres ne connaissent pas le problème, il faut donc se mettre a leur place et donner le maximum d'info, a noter egalement qu'en general, un exemple vaut mieux qu'un long discour.

En attendant plus d'information,

@+

 

[pierrejean]

essaie ce fichier [file name=pourJJ.zip size=7128]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/pourJJ.zip[/file]

 

[porcinet82]

re,

Pierrejean, je ne comprend pas tres bien à quoi sert le MsgBox (fin). Sinon pour le reste du code je pensais à quelque chose de ce genre, mais je preferai avoir un exemple afin d'adapter directement.

@+