Boucle infinie recalcitrante
Bonjour a tous ,
Je me permet de vous solliciter pour une boucle "for" dont je n'arrive pas a sortir .
Elle boucle jusqu'a l'iteration numero 272 puis recommence avec i= 1
Elle se situe dans la procedure
Sub ouicolorie
.J'aie mis un
debug.assert <272>
pour voir ce qui se passe
au moment de sortir cad la derniere iteration .
Le point d'entree du programme , c'est la procedure nommee
Sub calcul ratio
situe dans le module
MonModule
Mais avant , il faut selectionner le fichier nomme "Materiaux" .C'est important parce que le programme doit
detecte quel est le classeur actif .Ensuite seulement , il est possible de lancer la procedure nomme
Sub calcul ratio
Grosso modo , j'aie 2 fichiers que je vous joins , j'envoie un code article lu dans le fichier
vers le fichier"Traitement.xslm"
. Puis je recherche ce code article dans le fichier"Materiaux"
.Si il est trouve alors la ligne se colorie en"Materiaux"
.jaune
Tout se passe bien (les articles sont trouves , les lignes se colorient en jaune 0mais a la derniere iteration , je n'arrive pas a sortir .
Je pense que le probleme vient d'excel et pas du code . Il doit me manquer une instruction ou une logique d'excel que je ne comprend pas
Ci-joint les 2 fichiers en question
Cordialement
NB : mon clavier est en QWERTY et n'a pas les accents , desole pour l'orthographe .
Bonjour,
Je pense que le probleme vient d'excel et pas du code
Là, tu te trompes !
Dans "calculratio" tu appelles "decoupecellule()" de 1 à derlign (ici 272 fois) qui elle appelle "supprdoublons()" qui à son tour appelle "ouicolorie()" et donc il est tout à fait normal que "ouicolorie()" soit appelé 272 fois !
Si tu ne veux pas qu'elle soit appelée 272 fois, il te faut l'appeler après ta boucle de cette façon :
Sub calculratio()
Dim derlign As Integer
Dim rng As Range
Dim cellule As String
Dim i As Integer
derlign = ActiveSheet.Range("A65536").End(xlUp).Row
'Comment boucler sur une colonne ?
Set rng = ActiveSheet.Columns("A")
nomdufichier = ActiveWorkbook.Name
For i = 1 To derlign
' si un caractere "*" est trouve dans la cellule alors
If InStr(1, rng.Cells(i, 1).Value, "*") <> 0 Then
'Debug.Print rng.Cells(RowIndex:=i, ColumnIndex:="A").Value
cellule = rng.Cells(i, 1).Value
decoupecellule cellule
End If
Next
ouicolorie
Set rng = Nothing
End Sub
et bien sûr, il faut supprimer l'appel dans la sub "supprdoublons()" :
Sub supprdoublons()
Dim derlign As Integer
derlign = Sheets("Database").Range("A85536").End(xlUp).Row
Workbooks("Traitement.xlsm").Worksheets("Database").Activate
' excel a un bouton pour supprimer les doublons voir code ci dessous
Workbooks("Traitement.xlsm").Worksheets("Database").Range("A" & derlign).RemoveDuplicates Columns:=1, Header:=xlYes
''''' Call ouicolorie
Call presentation
End Sub
et il en va de même pour la sub "presentation()" qui elle aussi est appelée 272 fois !
Effectivement , je faisais trop de boucles imbriquees et j'aie manque de logique .
Voici une solution qui me satisfait ci dessous .J'aie sorti mes appels de procedures de la "boucle mere"
Merci de m'avoir mis sur la voie ,ce n'etait pas complique comme je m'en doutais .Juste un manque de logique ...
Sub calculratio()
Application.ScreenUpdating = False
Dim derlign As Integer
derlign = ActiveSheet.Range("A65536").End(xlUp).Row
Dim rng As Range
Set rng = ActiveSheet.Columns("A")
nomdufichier = ActiveWorkbook.Name
Dim cellule As String
Dim i As Integer
For i = 1 To derlign
' si un caractere "*" est trouve dans la cellule alors
If InStr(1, rng.Cells(RowIndex:=i, ColumnIndex:="A").Value, "*") <> 0 Then
'Debug.Print rng.Cells(RowIndex:=i, ColumnIndex:="A").Value
cellule = rng.Cells(RowIndex:=i, ColumnIndex:="A").Value
Call decoupecellule(cellule)
End If
Next
Call supprdoublons
Call presentation
Call ouicolorie
Set rng = Nothing
End Sub
Bonjour,
Tu peux tout à fait utiliser :
Call supprdoublons
Call presentation
Call ouicolorie
mais ça fonctionne aussi de cette façon :
supprdoublons
presentation
ouicolorie
Bonne continuation