VBA excel 2003 comparaison de lignes multiples critères
Bonjour,
Bonjour le forum,
J'aurais besoin de quelqu'un avec un peu plus de logique que moi :
J'ai un fichier avec 3000 lignes. Je veux pouvoir comparer des lignes entre elles, "récupérer" celles qui ont le même id ( colonne E), repérer la plus vieille ( celle qui a le numéro de version le plus petit ( plus petit chiffre dans la colonne L) à ce moment la mettre en gras, et enfin vérifier la valeur dans les colonnes I et J ( ces 2 colonnes doivent comporter une valeur définie ). Une fois toutes ces conditions remplies, j'aimerais importer les lignes qui vérifient toutes les conditions dans une 2 ème feuille.
On m'a proposé le code suivant. Mais j'ai un souci au moment de la copie :" Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille " ce n'est pas la bonne syntaxe je pense .
Quelqu'un pourrait -il me renseigner ?
Bonjour le forum,
J'aurais besoin de quelqu'un avec un peu plus de logique que moi :
J'ai un fichier avec 3000 lignes. Je veux pouvoir comparer des lignes entre elles, "récupérer" celles qui ont le même id ( colonne E), repérer la plus vieille ( celle qui a le numéro de version le plus petit ( plus petit chiffre dans la colonne L) à ce moment la mettre en gras, et enfin vérifier la valeur dans les colonnes I et J ( ces 2 colonnes doivent comporter une valeur définie ). Une fois toutes ces conditions remplies, j'aimerais importer les lignes qui vérifient toutes les conditions dans une 2 ème feuille.
On m'a proposé le code suivant. Mais j'ai un souci au moment de la copie :" Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille " ce n'est pas la bonne syntaxe je pense .
Quelqu'un pourrait -il me renseigner ?
Sub BrutOpModif()
Dim Plage As Range
Dim Cel As Range
Dim CelTrouve As Range
With ActiveSheet
Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp))
End With
For Each Cel In Plage
Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole)
If Not CelTrouve Is Nothing Then
If CelTrouve.Address <> Cel.Address Then
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
End If
End If
Next Cel
End Sub
14 réponses
Résumé de la discussion
Un utilisateur veut comparer des lignes par identifiant en colonne E, repérer la plus vieille version selon L, vérifier I et J et importer les lignes correspondantes dans une seconde feuille. Plusieurs propositions de code s'appuient sur une macro qui compare les valeurs en E, sélectionne la plus ancienne selon L et copie les lignes vers Feuil2 après vérification des colonnes I et J. Des interventions proposent de corriger la syntaxe de copie vers Feuil2 et d'utiliser Find pour gérer les lignes déjà présentes, via une fonction VerifieColIetJ pour I et J. Si des accrocs apparaissent, les échanges soulignent l'importance d'initialiser des compteurs et de prévoir des cas où une même E peut recouvrir plusieurs versions.
-
Coucou,
oui, il y a un prolbème, remplace :
Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
par :
Sheets("Feuil1").Rows(ligne).Copy
Sheets("Feuil2").Rows(m).select
Activesheet.paste
et ca devrait marcher! -
ContributeurBonjour,
Apparemment, la variable m n'a pas été initialisé au départ et tu as la valeur de m dans ta ligne
à moins que....
sinon, ta syntaxe de la ligne est la meilleure
-
@ Melanie1234 : Je vais tester ça de ce pas
@michel_m : je t'avoue que ce code m'a été proposé. Je ne maîtrise pas encore les with , .cells()
J'avais testé mon code a moi qui fonctionnait, mais il y avait des erreurs sur certains cas particuliers.
@ tous les 2 : Merci pour vos réponses-
ContributeurJe ne t'ai pas parlé de with, cells()......????
si tu démarres tes copies ligne 2 de la feuille 2m=1 For Each Cel In Plage
......
si tu démarrestes copies ligne 1de la feuille 2
tu implémentes avantIf CelTrouve.Address <> Cel.Address Then If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente m=m+1 Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille etc.
et peut-être (je ne connais ton contexte)If CelTrouve.Address <> Cel.Address Then M=M+1 If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) etc... -
les with, cells() dont je parlais sont ceux dans le code que je proposais et que je ne maitrise pas...
Oui je vois pour l'initialisation du m, mais c'est la variable ligne qui me pose un souci :Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m)
(il m'affiche un message d'erreur sur cette ligne )
comme je l'ai fait remarquer je ne vois pas comment l'initialiser et récupérer la ligne de la cellule comparée dans <code>CelTrouve.Offset(, 5).Value<code>
-
-
oui j'ai peut être un souci avec mes variables, je ne déclare pas m ni ligne.
Mais comment récupérer le numéro de ma ligne qui m'intéresse et la glisser dans la variable ligne justement ? -
@melanie1234 : J'ai remplacé comme tu m'avais dit mais je ne vois pas comment récupérer ma ligne . Pourrais tu m'aiguiller stp ?
j'essaie d'initialiser ma variable et de l'affecter à la ligne de la cellule trouvée mais cela ne fonctionne pas :Dim m As Double Dim ligne As Double m = 0 ligne = CelTrouve.Rows Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m).Select ActiveSheet.Paste m = m + 1 -
Coucou
Pour info m est le numéro de ligne de ta feuille 2 donc si tu mets 0, il va copier à la ligne 0 la première fois==> ce quie st impossible.
Parce qu'il faut que tu mettes m=1 et ca marchera.
Donc ton code donne :
Sub BrutOpModif()
Dim Plage As Range
Dim Cel As Range
Dim CelTrouve As Range
m = 1
With ActiveSheet
Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp))
End With
For Each Cel In Plage
Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole)
If Not CelTrouve Is Nothing Then
If CelTrouve.Address <> Cel.Address Then
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy
Sheets("Feuil2").Rows(m).select
activesheet.paste
sheets("Feuil1).select 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy
Sheets("Feuil2").Rows(m).select
activesheet.paste
sheets("Feuil1).select
'Alors on copie la ligne dans la 2eme feuille
sheets("Feuil1").select
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy
Sheets("Feuil2").Rows(m).select
Activesheet.paste
'Alors on copie la ligne dans la 2eme feuille
m = m + 1
ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente
Sheets("Feuil1").Rows(ligne).Copy
Sheets("Feuil2").Rows(m) .select
Activesheet.paste'Alors on copie la ligne dans la 2eme feuille
sheets("Feuil1").select
m = m + 1
End If
End If
Next Cel
End Sub
Mélanie -
Oui pardon j'avais oublié d'initialiser ma variable "m".
Mais il y a le souci de la variable "ligne" maintenant . -
Bonjour Michel.
Que me proposes tu de faire pour remplacer mes select/copy / paste ?
J'ai suivi ton conseil pourLigne=celtrouve.row
Mais j'ai toujours une erreur au niveau de ma ligne :Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
Sub BrutOpModif() Dim Plage As Range Dim Cel As Range Dim CelTrouve As Range m = 1 With ActiveSheet Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)) End With For Each Cel In Plage Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole) If Not CelTrouve Is Nothing Then If CelTrouve.Address <> Cel.Address Then If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente Ligne = CelTrouve.Row Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente Ligne = CelTrouve.Row Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m).Select ActiveSheet.Paste 'Alors on copie la ligne dans la 2eme feuille Sheets("Feuil1").Select m = m + 1 ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente Ligne = CelTrouve.Row Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m).Select ActiveSheet.Paste 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente Ligne = CelTrouve.Row Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m).Select Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 End If End If End If Next Cel End Sub -
coucou Melanie,
Merci pour ta réponse.
J'ai testé ton code et il me dit qu'il y a une erreur justement sur la ligne :
Sheets("Feuil2").Rows(m).Select 'Alors on copie la ligne dans la 2eme feuille -
ModérateurBonjour tout le monde,
@ klissou69 : sois plus précis sur ce forum. "J'ai un message d'erreur sur cette ligne" ne suffit généralement pas à obtenir une réponse adaptée. Donne nous également le message d'erreur complet.
@ Michel_m : salut! Comment va?
@Mélanie :
je ne sais pas remplacer le activesheet.paste par autre chose même si je sais que c'est lourd, si tu as une suggestion, je suis à l'écoute.
La bonne syntaxe est celle proposée dès le début.
Range(acopier).copy Range(oucoller)
Avec un espace entre les deux range.
Ce qui, dans le cas d'aujourd'hui, nous donne :Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m)
Si cela ne "passe" pas, on peut utiliser la feuille "ou coller" dans un bloc with end with. A ce moment là, il ne faut pas oublier le point devant le range qui s'y rapporte :With Sheets("Feuil2") Sheets("Feuil1").Rows(ligne).Copy .Rows(m) End With
S'il y a toujours une erreur c'est que :
1- la feuille "Feuil2" ne s'appelle pas comme ça, tenter de vérifier s'il n'y a pas un espace "viscieux" après le 2, du genre : "Feuil2 " ou " Feuil2" ou "Feuil 2"...
2- il n'y a pas de ligne m dans la feuille 2... Sissi c'est possible si m = -3...
3- il n'y a pas, dans le classeur concerné de :
- Feuil1
- Feuil2
etc....... -
Tout d'abord pour vos réponses et désolé pour mes imprécisions .
1ère nouvelle bonne nouvelle cela fonctionne :)
Malheureusement il n'affiche que 11 résultats ( au lieu de 138 ), alors que le filtre est bon ( les différents critères type :If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then
sont corrects.
Je ne comprends donc pas pourquoi il ne prend pas les autres lignes qui 'correspondent '.
Ci-joint mon code du moment :
Sub BrutOpModif() Dim Plage As Range Dim Cel As Range Dim CelTrouve As Range m = 1 With ActiveSheet Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)) End With For Each Cel In Plage Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole) If Not CelTrouve Is Nothing Then If CelTrouve.Address <> Cel.Address Then If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente ligne = CelTrouve.Row Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) m = m + 1 Sheets("Feuil1").Select ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente ligne = CelTrouve.Row Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 Sheets("Feuil1").Select ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente ligne = CelTrouve.Row Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 Sheets("Feuil1").Select ElseIf CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente ligne = CelTrouve.Row Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) m = m + 1 Sheets("Feuil1").Select 'Alors on copie la ligne dans la 2eme feuille End If End If End If Next Cel End Sub -
Y a pas de soucis moi je réexplique autant de fois que tu veux.
J'ai une feuille 1 de 3000 lignes . Il faut que je compare les lignes entre elles selon leurs id ( colonne E). Toutes celles qui ont le même id je les compare entre elle. Une fois ce premier critère validé, il faut que je récupère la ligne qui a le numéro de version le plus petit ( colonne L ) dont les critères des colonnes I et J vérifient les conditions citées plus haut : VERIFIED MO , PENDING MO etc...
Pour résumer, on compare les id, puis ceux ayant le même id on vérifie leur critères, une fois qu'on a récup les critères valables, il faut identifier la version la plus vieille .-
ModérateurAlors, sans garantie car je l'ai codé "à la volée" ici même, test ce code [que je n'ai pas testé moi-même!!]. Je l'ai commenté...
En fait le code procède comme ceci :
Pour toutes les cellules de la plage E1:EdernièreLigne
1- si col I = VERIFIED et Col J = PENDING_MO alors
2- On cherche, dans la feuille 2 colonne E si la valeur contenue Feuil1E est présente
3- si elle est présente (en gros ça veut dire qu'on l'a déjà copiée) alors elle teste si la colonne L est supérieure.
4- si oui, elle remplace
5- si non, elle ne fait rien.
6- Si la valeur n'est pas présente en Feuil2, alors elle copie la ligne...
Sub BrutOpModif() Dim Plage As Range Dim Cel As Range Dim CelTrouve As Range Dim m As Long m = 2 With Sheets("Feuil1") Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)) End With With Sheets("Feuil2") For Each Cel In Plage 'pour toutes les cellules Feuil1 Col E 'Si on a VERIFIED col I et PENDING_MO Col J alors If Cel.Offset(0, 4).Value = "VERIFIED" And Cel.Offset(0, 5).Value = "PENDING_MO" Then 'on cherche, Feuil2 Col E si la valeur existe déjà (ligne déjà copiée) Set CelTrouve = .Columns(5).Cells.Find(Cel.Value, lookin:=xlvalues, lookat:=xlwhole) 'Si la valeur existe (ligne préalablement copiée) If Not CelTrouve Is Nothing Then 'on compare les valeurs Col L Feuil2 et Feuil1 If CelTrouve.Offset(0, 7).Value < Cel.Offset(0, 7).Value Then 'On copie Feuil1 en Feuil2 si L est plus grand Sheets("Feuil1").Rows(Cel.Row).Copy .Rows(CelTrouve.Row) End If Else 'Si par contre la valeur n'existe pas Feuil2 'alors on la copie colle Sheets("Feuil1").Rows(Cel.Row).Copy .Rows(m) m = m + 1 End If End If Next Cel End With -
Bonjour Pijaku, ton code marche très bien , je te remercie, j'ai les lignes correspondantes qui sortent. Pourrait on rajouter 4 critères je te prie ?
Il faudrait faire ressortir les lignes les plus anciennes pour chaque 'id' dont les colonnes contiennent les valeurs suivantes :
VERIFIED_MO col I et PENDING_MO Col J
AFFIRMED_BO col I et PENDING_MO Col J
CANCELLED col I
CANCEL col J
Du coup j'ai rajouté ces conditions à la ligne :(Cel.Offset(0, 4).Value = "VERIFIED" And Cel.Offset(0, 5).Value = "PENDING_MO") Or (Cel.Offset(0, 4).Value = "VERIFIED_MO" And Cel.Offset(0, 5).Value = "PENDING_MO") Or (Cel.Offset(0, 4).Value = "AFFIRMED_MO" And Cel.Offset(0, 5).Value = "PENDING_MO") Or (Cel.Offset(0, 4).Value = "CANCELED") Or (Cel.Offset(0, 5).Value = "CANCEL")
Mais il me manque quelques lignes. Les critères sont bons comme je les ais écrit ? -
ModérateurSalut,
D'où l'inconvénient de ne pas exposer clairement son problème dès le départ...
D'autres auraient abandonné (à juste titre) à ce moment.
Je vais tenter de continuer.
Par contre, je ne comprends rien de rien à ce que tu souhaites maintenant. Faut que tu ré-explique tout depuis le début. -
Je ne vois pas comment exposer le problème plus clairement mais je vais tenter une nouvelle fois. Le résultat est bon, c'est cela que je veux . Mais il y a un cas particulier qui m'embête et qui doit être à l'origine de "l'oubli " de quelques lignes. Imaginons une ligne au début dont la version est 1 ( la plus vieille possible) mais dont les critères ne sont pas respectés ( ni verified col I ni pending_mo col J ) etc, la ligne va quand même être sélectionnée étant donnée qu'elle a le numéro de version le plus vieux ( 1 ) .
Voila je pense avoir résumé le plus clairement possible, si tu n'y vois toujours pas plus clair c'est que je ne résoudrai pas ce problème donc tu peux abandonner ;)
Merci pour ton aide en tout cas.
A titre indicatif voici le code que j'avais crée au tout début, qu'on m'a reproché d'être scolaire, sale etc, mais il fonctionnait de la même façon que le tien. Seul hic, comme énoncé précédemment, si une version antérieure était détectée au début, elle était conservée alors qu'elle n'était pas "valable" ( critères non respectés ).
Sub BrutOpModif() Dim m As Integer Dim Min As Integer 'Dim minn As Integer Dim Maligne As Integer m = 2 nbcolonne1 = Sheets("Feuil1").UsedRange.Columns.Count 'compte le nombre de colonnes non vides sur la feuille 1 nbligne1 = Sheets("Feuil1").UsedRange.Rows.Count 'compte le nombre de lignes non vides sur la feuille 1 For ligne = 2 To nbligne1 If ligne = 2 Then 'Je ne comprends pas cette condition. Ca veut dire qu'elle n'est valable que la 1ere fois ? Min = Cells(ligne, 12) ' ? Maligne = ligne Else If Cells(ligne, 5) = Cells(ligne - 1, 5) Then 'Si l'id est égal à l'id d'avant If Cells(ligne, 12) < Min And Cells(ligne, 9) = "VERIFIED" And Cells(ligne, 10) = "PENDING_MO" Then ' et si ma version est la plus récente Min = Cells(ligne, 12).Value 'alors on incrémente le min Maligne = ligne ' et on prend le numéro de ligne ElseIf Cells(ligne, 12) < Min And Cells(ligne, 9) = "AFFIRMED_BO" And Cells(ligne, 10) = "PENDING_MO" Then ' et si ma version est la plus récente Min = Cells(ligne, 12).Value 'alors on incrémente le min Maligne = ligne ' et on prend le numéro de ligne ElseIf Cells(ligne, 12) < Min And Cells(ligne, 9) = "VERIFIED_MO" And Cells(ligne, 10) = "PENDING_MO" Then ' et si ma version est la plus récente Min = Cells(ligne, 12).Value 'alors on incrémente le min Maligne = ligne ' et on prend le numéro de ligne ElseIf Cells(ligne, 12) < Min And Cells(ligne, 9) = "CANCELED" Then ' et si ma version est la plus récente Min = Cells(ligne, 12).Value 'alors on incrémente le min Maligne = ligne ' et on prend le numéro de ligne End If Else Rows(Maligne).Font.Bold = True 'On met ensuite la ligne en gras. Mais ici,cela va mettre en gras chaque ligne dont la version est inférieure. S'il y a 6,5,4,3,2 par exemple dans la colonne 12 , dans cet ordre, les 5 lignes vont être en gras Min = Cells(ligne, 12).Value Maligne = ligne End If End If Next For ligne = 2 To nbligne1 If Cells(ligne, 9) = "VERIFIED" And Cells(ligne, 10) = "PENDING_MO" And Rows(ligne).Font.Bold = True Then ' si ces 2 critères sont validés Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf Cells(ligne, 9) = "AFFIRMED_BO" And Cells(ligne, 10) = "PENDING_MO" And Rows(ligne).Font.Bold = True Then ' si ces 2 critères sont validés Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf Cells(ligne, 9) = "VERIFIED_MO" And Cells(ligne, 10) = "PENDING_MO" And Rows(ligne).Font.Bold = True Then ' si ces 2 critères sont validés Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf Cells(ligne, 9) = "CANCELED" And Rows(ligne).Font.Bold = True Then ' si ces 2 critères sont validés Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 ElseIf Cells(ligne, 10) = "CANCEL" And Rows(ligne).Font.Bold = True Then ' si ces 2 critères sont validés Sheets("Feuil1").Rows(ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille m = m + 1 End If Next End Sub -
ModérateurC'est ça que je ne peux pas comprendre :
Imaginons une ligne au début dont la version est 1 ( la plus vieille possible) mais dont les critères ne sont pas respectés ( ni verified col I ni pending_mo col J ) etc, la ligne va quand même être sélectionnée étant donnée qu'elle a le numéro de version le plus vieux ( 1 ) .
Dans mon code, cette ligne (si ni verified col I ni pending_mo col J) n'est pas copiée...
Si tu veux qu'elle le soit, faut ajouter un test. Tu dis...
-
-
bonjour,
parce quil subsiste une petite erreur , remplace ton code par :
Sub BrutOpModif()
Dim Plage As Range
Dim Cel As Range
Dim CelTrouve As Range
m = 1
With ActiveSheet
Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp))
End With
For Each Cel In Plage
Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole)
If Not CelTrouve Is Nothing Then
If CelTrouve.Address <> Cel.Address Then
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").Rows(m).select 'Alors on copie la ligne dans la 2eme feuille
Activesheet.paste
sheets("Feuil1").select
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").Rows(m).Select
ActiveSheet.Paste
'Alors on copie la ligne dans la 2eme feuille
Sheets("Feuil1").Select
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").Rows(m).Select
ActiveSheet.Paste
'Alors on copie la ligne dans la 2eme feuille
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").Rows(m).Select
Sheets("Feuil1").Rows(Ligne).Copy Sheets("Feuil2").Rows(m) 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
End If
End If
End If
Next Cel
End Sub
Pour Michel, je ne sais pas remplacer le activesheet.paste apr autre chose même si je sais que c'est lourd, si tu as une suggestion, je suis à l'écoute. -
décompose comme ca alors :
Sub BrutOpModif()
Dim Plage As Range
Dim Cel As Range
Dim CelTrouve As Range
m = 1
With ActiveSheet
Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp))
End With
For Each Cel In Plage
Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlWhole)
If Not CelTrouve Is Nothing Then
If CelTrouve.Address <> Cel.Address Then
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").select
Rows(m).select 'Alors on copie la ligne dans la 2eme feuille
Activesheet.paste
sheets("Feuil1").select
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "AFFIRMED_BO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").select
Rows(m).Select
ActiveSheet.Paste
'Alors on copie la ligne dans la 2eme feuille
Sheets("Feuil1").Select
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "VERIFIED_MO" And CelTrouve.Offset(, 5).Value = "PENDING_MO" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").select
Rows(m).Select
ActiveSheet.Paste
'Alors on copie la ligne dans la 2eme feuille
m = m + 1
Else
If CelTrouve.Offset(, 7).Value < Cel.Value And CelTrouve.Offset(, 4).Value = "CANCELED" Then ' et si ma version est la plus récente
Ligne = CelTrouve.Row
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2")select
.Rows(m).Select
Sheets("Feuil1").Rows(Ligne).Copy
Sheets("Feuil2").select
Rows(m).select
activesheet.paste
sheets("Feuil1").select 'Alors on copie la ligne dans la 2eme feuille
m = m + 1
End If
End If
End If
Next Cel
End Sub
