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

"Traitement.xslm"

"Materiaux"

"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