Microsoft 365 Boucle infini

[Rhm93]

Bonjour, je rencontre un problème je suis en train de developper une macro me permettant de mettre "X" tant que le cumul en colonne ne dépasse une valeur.
Le problème ici c'est que ma macro marche très bien pour les 3 premières colonnes mais à partir de la 4 ème colonne il y a une boucle infinie qui se crée.
Voici la macro en question :

Sub lisser()
'

Dim cumul As Integer

cumul = 0
i = 3
Col = 8


Do Until Cells(2, 8).Value + Cells(i, 7).Value >= 105
cumul = cumul + Cells(i, 7).Value

Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Loop
Col = Col + 1
If Cells(2, 8).Value <> 0 Then
Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
cumul = cumul + Cells(i, 7).Value

Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Loop
End If
Col = Col + 1
If Cells(2, 8).Value <> 0 Then
Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
cumul = cumul + Cells(i, 7).Value
Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Loop
End If
Col = Col + 1
If Cells(2, 8).Value <> 0 Then
Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
cumul = cumul + Cells(i, 7).Value

Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Loop
End If
Col = Col + 1
If Cells(2, 8).Value <> 0 Then
Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
cumul = cumul + Cells(i, 7).Value

Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Loop
End If
Col = Col + 1
If Cells(2, 8).Value <> 0 Then
While Cells(2, Col).Value + Cells(i, 7).Value < 105
cumul = cumul + Cells(i, 7).Value

Worksheets("Feuil3").Cells(i, Col).Value = "X"

i = i + 1

Wend
End If

End Sub

et je vous joins en PJ l'excel exemple

 

[sylvanu]

Bonjour Rhm,
Je ne comprends pas en quoi mon fichier de

Microsoft 365 - VBA Optimasation charge travail

Bonjour dans le cadre d'un projet en vba je dois lisser une charge de travail. La charge de travail max par semaine est de 105 Heures. Si cette dernière est dépassée il faut que la tâche soit reporté à la semaine prochaine. Mais je rencontre un problème lorsqu'il faut décaler les tâches...

www.excel-downloads.com

ne vous va pas. Il fait strictement la même chose sans boucle infinie et en quelques lignes :

Sub Compte()
DerLig = Range("G65500").End(xlUp).Row
Range("H2:ZZ" & DerLig).ClearContents
Colonne = 8 ' Première colonne où on met un X
Somme = 0   ' Somme des heures
For L = 2 To DerLig
    Somme = Somme + Cells(L, "G")
    If Somme <= 105 Then
        Cells(L, Colonne) = "X"
    Else                        ' Si somme >105
        Somme = 5               ' On remet le compte d'heures à 5
        Colonne = Colonne + 1   ' On passe à la colonne suivante
        Cells(L, Colonne) = "X"
    End If
Next L
End Sub

 

[Phil69970]

Bonjour Rhm93, le forum

1)Ton code mieux indenté serait plus lisible

Sub lisser()

Dim cumul As Integer

cumul = 0
i = 3
Col = 8

Do Until Cells(2, 8).Value + Cells(i, 7).Value >= 105
    cumul = cumul + Cells(i, 7).Value
    Worksheets("Feuil3").Cells(i, Col).Value = "X"
    i = i + 1
Loop

Col = Col + 1

If Cells(2, 8).Value <> 0 Then
    Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
        cumul = cumul + Cells(i, 7).Value
        Worksheets("Feuil3").Cells(i, Col).Value = "X"
        i = i + 1
    Loop
End If

Col = Col + 1
If Cells(2, 8).Value <> 0 Then
    Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
        cumul = cumul + Cells(i, 7).Value
        Worksheets("Feuil3").Cells(i, Col).Value = "X"
        i = i + 1
    Loop
End If

Col = Col + 1
If Cells(2, 8).Value <> 0 Then
'************
'PB à partir d'ici
'************
    Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
        cumul = cumul + Cells(i, 7).Value
        Worksheets("Feuil3").Cells(i, Col).Value = "X"
        i = i + 1
    Loop
End If

Col = Col + 1
If Cells(2, 8).Value <> 0 Then
    Do Until Cells(2, Col).Value + Cells(i, 7).Value >= 105
        cumul = cumul + Cells(i, 7).Value
        Worksheets("Feuil3").Cells(i, Col).Value = "X"
        i = i + 1
    Loop
End If

Col = Col + 1
If Cells(2, 8).Value <> 0 Then
    While Cells(2, Col).Value + Cells(i, 7).Value < 105
        cumul = cumul + Cells(i, 7).Value
        Worksheets("Feuil3").Cells(i, Col).Value = "X"
        i = i + 1
    Wend
End If

End Sub

2)A partir de l'annotation tu as un pb car il n'y a plus de données en G71 et suivantes...

3)Je suis sur que ton code peut être grandement simplifié

*Edit Bonjour Sylvain
La proposition de Sylvain va très bien....

@Phil69970