Probleme de logique avec une boucle while dans une macro excel

Résolu
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013 - 15 avril 2008 à 16:20
yrem1 Messages postés 2 Date d'inscription vendredi 12 octobre 2007 Statut Membre Dernière intervention 5 novembre 2010 - 14 janv. 2010 à 14:06
Bonjour, j’ai un problème de logique et je ne sais pas comment le résoudre : je vais essayer d’être clair,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??>






 






J’ai une boucle While qui dit que tant que la cellule active n’est pas vide > continuer les instructions.






 






Je voudrais dire à cette boucle While de sauter toutes les cellules surlignée en jaune ou écrite en vert, donc j’ai inclus cette ligne dans mon code:






 






if ActiveCell.Interior.Color vbYellow Or ActiveCell.Font.ColorIndex 10 Then ActiveCell.Offset(1, 0).Activate






 






Problème: ca marche super bien pour la première ligne mais au moment de passer a la ligne suivante mon instruction IF n’est plus prise en compte, ce qui est logique mais je voudrais que la macro fasse ce test IF sur chaque ligne pas seulement la première… comment faire ?






 






Un condensé de ma macro serait :






 






Sub






 






While ActiveCell.Value <> Empty






 






If ActiveCell.Interior.Color vbYellow Or ActiveCell.Font.ColorIndex 10 Then ActiveCell.Offset(1, 0).Activate






 






‘Instructions copier / coller sur une autre feuille






 






ActiveCell.Offset(1, 0).Activate






 






Wend






 






End Sub






 





Si quelqu’un à la solution a ce problème ce serait sympa de me filer un coup de main !

11 réponses

bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 13
15 avril 2008 à 18:06
...

tient regarde je te montre un truc :

Sub Test()
    Dim LigneActive As String
    Dim directory As String
    Dim file As String
    Dim extension As String
    Sheets("Workbook").Activate
    While Not IsEmpty(ActiveCell)
        If (ActiveCell.Interior.Color <> vbYellow) And (ActiveCell.Font.ColorIndex <> 10) Then
            LigneActive = ActiveCell.Row            If Cells(LigneActive, 8) "FUL" Then Cells(LigneActive, 7) "FUL" Else Cells(LigneActive, 7) = "MOE"
            Cells(ActiveCell.Row, 14) = ActiveCell.Row - 4   'Iteration
            With Sheets("Checklist")
                'Purchase Order Number
                'Attention au point devant le Range il est obligatoire sans lui cela ne marche pas
                .Range("D3:K4").Value = Cells(LigneActive, 1).Value
                'Agreement Number
                .Range("D5:K6").Value = Cells(LigneActive, 9).Value
                'Agreement Type
                .Range("D7:E7").Value = Cells(LigneActive, 11).Value
                'Version
                .Range("F7:G7").Value = Cells(LigneActive, 13).Value
                'End Customer
                .Range("D9:K12").Value = Cells(LigneActive, 2).Value
                'Iteration
                .Range("D68").Value = Cells(LigneActive, 14).Value
                'Exception
                .Range("B4:C4").Value = Cells(LigneActive, 8).Value
            End With
            directory = "C:\Documents and Settings\v-cybour\Desktop\MOET\MOET Checklists\To print\Temp"
            file = Range("B6").Value & " - Academic MOET Order Checklist " & Range("D68").Value
            extension = ".xls"
            ActiveWorkbook.SaveAs directory & file & extension
            Sheets("Workbook").Activate
        End If
        ActiveCell.Offset(1, 0).Activate
    Wend
End Sub

ce code fait la meme chose plus vite et sans rendre epileptique un aveugle. Pour la mise en forme je te conseil de la faire a la main une bonne fois pour toute plutot que
d'utiliser le copier/coller.

A+
3
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 13
15 avril 2008 à 16:27
Salut,

jolie pseudo

comment tu passes a la deuxieme ligne ?

A+
0
jrivet Messages postés 7393 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
15 avril 2008 à 16:28
Salut,
Est ce que ceci t'irais

Sub Test()

   While Not IsEmpty(ActiveCell)
       If (ActiveCell.Interior.Color <> vbYellow) And (ActiveCell.Font.ColorIndex <> 10) Then
           'Instructions copier / coller sur une autre feuille
           
       End If
       ActiveCell.Offset(1, 0).Activate
   Wend

End Sub , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
0
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 13
15 avril 2008 à 16:29
...

ohhh ! avec le offset ! desolé pas fait gaffe

bon je regarde ca de plus pres

A+
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013
15 avril 2008 à 16:34
Si ca c’est pas de la réactivité ! merci pour cette réponse rapide !<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??>






 






Je passe a la ligne suivante avec l’instruction « ActiveCell.Offset(1, 0).Activate »






 






Mais le mieux est probablement que je déballe tout mon code (je voulais pas le faire, d’une parce que j’ai honte, de deux parce que je pensais que ce serait trop bordelique dans la question)






 






Quoi qu’il en soit avec le code ci-dessous le IF ne marche que sur la première ligne.






 





While ActiveCell.Value <> Empty



 




If ActiveCell.Interior.Color vbYellow Or ActiveCell.Font.ColorIndex 10 Then ActiveCell.Offset(1, 0).Activate



 




Dim LigneActive As String



 




LigneActive = ActiveCell.Row



 




If Cells(LigneActive, 8) "FUL" Then Cells(LigneActive, 7) "FUL" Else Cells(LigneActive, 7) = "MOE"



 




Cells(ActiveCell.Row, 14) = ActiveCell.Row - 4   'Iteration



 




Cells(LigneActive, 1).Select    'Purchase Order Number


Selection.Copy


Sheets("Checklist").Select


Range("D3:K4").Select


ActiveSheet.Paste



 




Sheets("Workbook").Activate       'Agreement Number


Cells(LigneActive, 9).Select


Selection.Copy


Sheets("Checklist").Select


Range("D5:K6").Select


ActiveSheet.Paste



 




Sheets("Workbook").Activate       'Agreement Type


Cells(LigneActive, 11).Select


Selection.Copy


Sheets("Checklist").Select


Range("D7:E7").Select


ActiveSheet.Paste



 




Sheets("Workbook").Activate       'Version


Cells(LigneActive, 13).Select


Selection.Copy


Sheets("Checklist").Select


Range("F7:G7").Select


ActiveSheet.Paste



 




Sheets("Workbook").Activate       'End Customer


Cells(LigneActive, 2).Select


Selection.Copy


Sheets("Checklist").Select


Range("D9:K12").Select


ActiveSheet.Paste



 




Sheets("Workbook").Activate       'Iteration


Cells(LigneActive, 14).Select


Selection.Copy


Sheets("Checklist").Select


Range("D68").PasteSpecial Paste:=xlPasteValues



 




Sheets("Workbook").Activate       'Exception


Cells(LigneActive, 8).Select


Selection.Copy


Sheets("Checklist").Select


Range("B4:C4").Select


ActiveSheet.Paste



 




Dim directory As String


Dim file As String


Dim extension As String



 




directory = "C:\Documents and Settings\v-cybour\Desktop\MOET\MOET Checklists\To print\Temp"


file = Range("B6").Value & " - Academic MOET Order Checklist " & Range("D68").Value


extension = ".xls"



 




ActiveWorkbook.SaveAs directory & file & extension



 




Sheets("Workbook").Activate



 





ActiveCell.Offset(1, 0).Activate






 






Wend






 






End Sub






 






Concernant mon pseudo je me suis un peu énervé lors de mon enregistrement … !






 






Merci Cyril
0
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 13
15 avril 2008 à 16:35
...

la solution de jrivet me parait bien.. bon ben je retourne me coucher bois

A+
0
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013
15 avril 2008 à 16:37
Merci beaucoup, je test et je vous dis !
0
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013
15 avril 2008 à 17:26
Merci, mais ca marche toujours pas ! : tant que le test IF tombe sur du jaune ou du vert alors il passe a la ligne suivante, si il tombe sur une cellule valide, il opere les instructions copier/coller.


Mais ca ne marche que tant que la boucle while n'est pas tombee sur une cellule valide car une fois qu'une cellule valide a ete activee, le Test IF ne marche plus.


est ce que je suis clair ? (meme pour moi c'est pas tres net!)


Merci d'avance !
0
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013
16 avril 2008 à 09:26
Merci beaucoup pour ton aide Bigfish, je test et je te dis si ca marche, en tout cas merci d'avoir pris le temps de te pencher sur mon probleme

A pluche, Cyril
0
loginalaconkejarrivpaaenregistre Messages postés 10 Date d'inscription vendredi 8 décembre 2000 Statut Membre Dernière intervention 7 septembre 2013
16 avril 2008 à 14:38
Big Fish, Merci ca marche au poil et c'est plus rapide, si tu passes sur Dublin, je te payes une biere !

Salut
0
yrem1 Messages postés 2 Date d'inscription vendredi 12 octobre 2007 Statut Membre Dernière intervention 5 novembre 2010
14 janv. 2010 à 14:06
[^^happy10]
0