Probleme de logique avec une boucle while dans une macro excel

Résolu
Signaler
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013
-
Messages postés
2
Date d'inscription
vendredi 12 octobre 2007
Statut
Membre
Dernière intervention
5 novembre 2010
-
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

Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
...

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+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
Salut,

jolie pseudo

comment tu passes a la deuxieme ligne ?

A+
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
...

ohhh ! avec le offset ! desolé pas fait gaffe

bon je regarde ca de plus pres

A+
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013

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
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
...

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

A+
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013

Merci beaucoup, je test et je vous dis !
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013

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 !
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013

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
Messages postés
10
Date d'inscription
vendredi 8 décembre 2000
Statut
Membre
Dernière intervention
7 septembre 2013

Big Fish, Merci ca marche au poil et c'est plus rapide, si tu passes sur Dublin, je te payes une biere !

Salut
Messages postés
2
Date d'inscription
vendredi 12 octobre 2007
Statut
Membre
Dernière intervention
5 novembre 2010

[^^happy10]