Probleme de logique avec une boucle while dans une macro excelRésolu

Question

Bonjour, j’ai un problème de logique et je ne sais pas comment le résoudre : je vais essayer d’être clair, 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 !

bigfish_le vrai · Accepted Answer

... 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+

bigfish_le vrai · Answer

Salut,

jolie pseudo

comment tu passes a la deuxieme ligne ?

A+

jrivet · Answer

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

bigfish_le vrai · Answer

...

ohhh ! avec le offset ! desolé pas fait gaffe 

bon je regarde ca de plus pres

A+

loginalaconkejarrivpaaenregistre · Answer

Si ca c’est pas de la réactivité ! merci pour cette réponse rapide ! 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

bigfish_le vrai · Answer

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

loginalaconkejarrivpaaenregistre · Answer

Merci beaucoup, je test et je vous dis !

loginalaconkejarrivpaaenregistre · Answer

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 !

loginalaconkejarrivpaaenregistre · Answer

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

loginalaconkejarrivpaaenregistre · Answer

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

yrem1 · Answer

[^^happy10]

Probleme de logique avec une boucle while dans une macro excel

11 réponses

Votre réponse

Discussions similaires