Do while loop avec 2 conditions
Bonsoir,
J'ai du mal avec ma boocle do while qui a 2 conditions. Le problème c'est que si elle vérifie une seul condition pas vrai elle sort de la boocle alors que moi je désire qu'elle vérifie les 2 conditions pas vrai pour qu'elle sort de la boocle.
do while (ecart1 < 0 and ecart1 > valeur1 and ecart2 < 0 and ecart2 > valeur2)
//instructions
loop
any help !!
Sans macro ni fichier : bonsoir !
Bonjour et bienvenu(e)
Bonjour MFerrand
Il faut un OU entre les conditions
Sub test()
Dim Ecart1 As Integer, Ecart2 As Integer
Dim Valeur1 As Integer, Valeur2 As Integer
Valeur1 = -10
Valeur2 = -10
Ecart1 = -5
Ecart2 = -5
Do While (Ecart1 < 0 And Ecart1 > Valeur1) Or (Ecart2 < 0 And Ecart2 > Valeur2)
Ecart1 = Ecart1 + 1
Ecart2 = Ecart2 + 2
Loop
MsgBox "Sortie :" & vbCr & "Ecart1 : " & Ecart1 & vbCr & "Ecart2 : " & Ecart2
End SubBonjour (edit : à tous),
si tu n'expliques pas avec des mots tes conditions de sortie on peut te faire un paquet de propositions.
Ce n'est pas un truc faux qui va nous faire trouver la bonne.
eric
Salut Banzai !
Belle démo !
Bonjour
@ MFerrand
Un peu rapide ma réponse (j'ai lu en travers)
Il faut boucler si un des 2 groupes de condition est toujours vrai
C'est vrai que tu as mis Or au lieu de And... Ça ne m'avait pas choqué !
Comme on n'a ni le contexte ni ce qui se passe dedans... C'était au moins une boucle dont on sort selon les instructions codées.
merci pour la réponse, j'ai compris un peu la démarche mais mon problème reste un peur compliqué vu que j'ai une grande base de données.
En résumant, la solution finale que je veux est la suivante: 0< ecart1<valeur1 ET 0<ecart2<valeur2 avec valuer 1<> valeur2
Tant que cette condition n'est pas vérifiée mon code à l'intérieur doit calculer à nouveau les 2 ecarts.
les écarts sont en fonction de 6 paramètres (a,b,c,a',b',c'), à chaque itération j'incrémente le paramètre a et je fixe les autres pour recalculer les écarts et par la suite vérifier la condition. Je risque de ne pas tomber dans la bonne solution, que puis-je faire ? et quelle sont vos suggestions.
voici le code
Sub estimation()
'Dim f As Single
'f = Timer()
Dim TC_SM As Single 'declaration des taux de cotisations pour SM et CAAD
Dim TC_CAAD As Single
Dim Max_SM, Max_CAAD As Long 'declaration des plafonds de cotisation pour SM et CAAD
Dim Min_SM, Min_CAAD As Long 'declaration des minimum de cotisation pour SM et CAAD
Dim ecart1, ecart2 As Long 'declaration des ecart BP - BA
Dim PPactifs_SM_MM, PPactifs_SM_ANP As Long 'declaration de la part patronale actifs pour SM pour MM et ANP
Dim PPactifs_CAAD_MM, PPactifs_CAAD_ANP As Long 'declaration de la part patronale actifs pour CAAD pour MM et ANP
Dim CA_MM, CA_ANP As Long
Dim min_seuil, max_seuil_MM, max_seuil_ANP As Long
Dim valeur1, valeur2 As Long
Dim i As Long
min_seuil = 0
valeur1 = 1880118.47
valeur2 = 768156.59
ecart1 = -3637894.14
ecart2 = -1105957
Dim ecartMM As Long
Dim ecartANP As Long
TC_SM = 0.05
TC_CAAD = 0.008
Max_SM = 930
Min_SM = 105
'Max_CAAD = 70
Min_CAAD = 11
'MsgBox TC_CAAD
'Application.ScreenUpdating = False
Do While (ecart1 < 0 And ecart2 < 0) Or (ecart1 < 0 And ecart2 > 0) Or (ecart1 > 0 And ecart2 < 0) or (ecart1 > valeur1 and ecart2>valeur2) or (ecart1>valeur2 and ecart2 <valeur2) or (ecart1<valeur1 and ecart2>valeur2)
TC_SM = TC_SM + 0.002 'modification des taux de cotisations
TC_CAAD = 0.008
Max_SM = Max_SM
Max_CAAD = 70
Min_SM = Min_SM
Min_CAAD = Min_CAAD
Feuil2.Select
'pour MM
'Application.ScreenUpdating = False
For i = 3 To Feuil2.Range("A3").End(xlDown).Row 'bcp de ligne (25333 ligne !!!)
'pour SM
If (Feuil2.Cells(i, 6).Value * TC_SM) > Max_SM Then
Feuil2.Cells(i, 15) = Max_SM
Else
Feuil2.Cells(i, 15).Value = (Feuil2.Cells(i, 6).Value * TC_SM)
End If
If Feuil2.Cells(i, 15).Value < Min_SM Then
Feuil2.Cells(i, 16).Value = Min_SM
Else
Feuil2.Cells(i, 16).Value = Feuil2.Cells(i, 15).Value
End If
'pour CAAD
If (Feuil2.Cells(i, 6).Value * TC_CAAD) > Max_CAAD Then
Feuil2.Cells(i, 17) = Max_CAAD
Else
Feuil2.Cells(i, 17).Value = (Feuil2.Cells(i, 6).Value * TC_CAAD)
End If
If Feuil2.Cells(i, 17).Value < Min_CAAD Then
Feuil2.Cells(i, 18).Value = Min_CAAD
Else
Feuil2.Cells(i, 18).Value = Feuil2.Cells(i, 17).Value
End If
Next i
'Application.ScreenUpdating = True
'MsgBox "ET: " & Format(Timer - f, "0.000") & "s"
'calcul de la somme de la PP actif pour le barème proposé pour SM_MM
'Feuil2.Range("P25334").Value = sumcode(Feuil2.Range("P3:P25333"))
Feuil2.Range("P25334").Value = Application.WorksheetFunction.Sum(Feuil2.Range("P3:P25333"))
Feuil2.Range("R25334").Value = Application.WorksheetFunction.Sum(Feuil2.Range("R3:R25333"))
'calcul du CA annuel pour la MM
CA_MM = Application.WorksheetFunction.Sum(Feuil2.Range("P25334").Value, Feuil2.Range("R25334").Value)
'calcul de l'ecart MM
Feuil4.Activate
ecartMM = CA_MM - Feuil4.Cells(13, 3).Value
Feuil4.Range("E14").Value = ecartMM
MsgBox ecartMM
ecart1 = ecartMM
'pour ANP
Feuil1.Activate
For i = 3 To Feuil1.Range("A3").End(xlDown).Row ' (11000 ligne)
'pour SM
If (Feuil1.Cells(i, 5).Value * TC_SM) > Max_SM Then
Feuil1.Cells(i, 15) = Max_SM
Else
Feuil1.Cells(i, 15).Value = (Feuil1.Cells(i, 5).Value * TC_SM)
End If
If Feuil1.Cells(i, 15).Value < Min_SM Then
Feuil1.Cells(i, 16).Value = Min_SM
Else
Feuil1.Cells(i, 16).Value = Feuil1.Cells(i, 15).Value
End If
'pour CAAD
If (Feuil1.Cells(i, 5).Value * TC_CAAD) > Max_CAAD Then
Feuil1.Cells(i, 17) = Max_CAAD
Else
Feuil1.Cells(i, 17).Value = (Feuil1.Cells(i, 5).Value * TC_CAAD)
End If
If Feuil1.Cells(i, 17).Value < Min_CAAD Then
Feuil1.Cells(i, 18).Value = Min_CAAD
Else
Feuil1.Cells(i, 18).Value = Feuil1.Cells(i, 17).Value
End If
Next i
'calcul de la somme de la PP actif pour le barème proposé pour SM_ANP et CAAD_ANP
Feuil1.Range("P11083").Value = Application.WorksheetFunction.Sum(Feuil1.Range("P3:P11082"))
Feuil1.Range("R11083").Value = Application.WorksheetFunction.Sum(Feuil1.Range("R3:R11082"))
'calcul du CA annuel pour la MM
CA_ANP = Application.WorksheetFunction.Sum(Feuil1.Range("P11083").Value, Feuil1.Range("R11083").Value)
'calcul de l'ecart MM
Feuil4.Activate
ecartANP = CA_ANP - Feuil4.Cells(13, 9)
Feuil4.Range("K14").Value = ecartANP
MsgBox ecartANP
ecart2 = ecartANP
Loop
'Application.ScreenUpdating = True
Feuil4.Range("E3").Value = TC_SM
Feuil4.Range("F3").Value = TC_CAAD
Feuil4.Range("E4").Value = Max_SM
Feuil4.Range("F4").Value = Max_CAAD
Feuil4.Range("E5").Value = Min_SM
Feuil4.Range("F5").Value = Min_CAAD
Feuil4.Range("E13").Value = CA_MM
Feuil4.Range("K13").Value = CA_ANP
Feuil4.Range("E14").Value = ecart1
Feuil4.Range("K14").Value = ecart2
End SubBonjour,
En résumant, la solution finale que je veux est la suivante: 0< ecart1<valeur1 ET 0<ecart2<valeur2 avec valuer 1<> valeur2
Tant que cette condition N'est PAS vérifiée mon code à l'intérieur doit calculer à nouveau les 2 ecarts
While NOT ( (0 < Ecart1 ) and (Ecart1<Valeur1) And (0 < Ecart2 ) and (Ecart1<Valeur2) aND (Valeur1 <> Valeur2)) Remarque préalable : tu dois déclarer le type de toutes tes variables : exemple :
Dim Max_SM As Long, Max_CAAD As Long
Celles dont le nom n'est pas suivi de As type sont de type Variant.
Remarque suivante : tu affectes des valeurs décimales à des variables déclarées de type Long !
C'est faisable, à condition de les convertir en Long avec la fonction CLng.
Déclaration de nouvelles variables en cours d'exécution : il est très généralement recommandé de déclarer toutes les variables en début de procédure.
La condition de sortie de boucle devrait pouvoir se réduire à :
Do While ecart1 > 0 And ecart2 > 0 And ecart1 < valeur1 And ecart2 < valeur2 TC_SM = TC_SM + 0.002
TC_CAAD = 0.008
Max_SM = Max_SM
Max_CAAD = 70
Min_SM = Min_SM
Min_CAAD = Min_CAADLes lignes surlignées sont inutiles, affectations déjà faites, et si Max_CAAD n'est pas injustifiée c'est juste parce que l'affection a été invalidée plus haut.
Les Select sont inutiles (pertes de temps), les parenthèses aussi lorsqu'il n'y a pas de priorités d'opérateurs à forcer.
Pour y voir plus clair :
'pour MM
'Application.ScreenUpdating = False
With Feuil2
For i = 3 To .Range("A3").End(xlDown).Row
'pour SM
If .Cells(i, 6).Value * TC_SM > Max_SM Then
.Cells(i, 15) = Max_SM
Else
.Cells(i, 15).Value = .Cells(i, 6).Value * TC_SM
End If
If .Cells(i, 15).Value < Min_SM Then
.Cells(i, 16).Value = Min_SM
Else
.Cells(i, 16).Value = .Cells(i, 15).Value
End If
'pour CAAD
If .Cells(i, 6).Value * TC_CAAD > Max_CAAD Then
.Cells(i, 17) = Max_CAAD
Else
.Cells(i, 17).Value = .Cells(i, 6).Value * TC_CAAD
End If
If .Cells(i, 17).Value < Min_CAAD Then
.Cells(i, 18).Value = Min_CAAD
Else
.Cells(i, 18).Value = .Cells(i, 17).Value
End If
Next i
'calcul de la somme de la PP actif pour le barème proposé pour SM_MM
.Range("P25334").Value = Application.WorksheetFunction.Sum(.Range("P3:P25333"))
.Range("R25334").Value = Application.WorksheetFunction.Sum(.Range("R3:R25333"))
'calcul du CA annuel pour la MM
CA_MM = Application.WorksheetFunction.Sum(.Range("P25334").Value, .Range("R25334").Value)
End With
'calcul de l'ecart MM
With Feuil4
ecartMM = CA_MM - .Cells(13, 3).Value
.Range("E14").Value = ecartMM
'MsgBox ecartMM
ecart1 = ecartMM
End With
'pour ANP
With Feuil1
For i = 3 To .Range("A3").End(xlDown).Row
'pour SM
If .Cells(i, 5).Value * TC_SM > Max_SM Then
.Cells(i, 15) = Max_SM
Else
.Cells(i, 15).Value = .Cells(i, 5).Value * TC_SM
End If
If .Cells(i, 15).Value < Min_SM Then
.Cells(i, 16).Value = Min_SM
Else
.Cells(i, 16).Value = .Cells(i, 15).Value
End If
'pour CAAD
If .Cells(i, 5).Value * TC_CAAD > Max_CAAD Then
.Cells(i, 17) = Max_CAAD
Else
.Cells(i, 17).Value = .Cells(i, 5).Value * TC_CAAD
End If
If .Cells(i, 17).Value < Min_CAAD Then
.Cells(i, 18).Value = Min_CAAD
Else
.Cells(i, 18).Value = .Cells(i, 17).Value
End If
Next i
'calcul de la somme de la PP actif pour le barème proposé pour SM_ANP et CAAD_ANP
.Range("P11083").Value = Application.WorksheetFunction.Sum(.Range("P3:P11082"))
.Range("R11083").Value = Application.WorksheetFunction.Sum(.Range("R3:R11082"))
'calcul du CA annuel pour la MM
CA_ANP = Application.WorksheetFunction.Sum(.Range("P11083").Value, .Range("R11083").Value)
End With
'calcul de l'ecart MM
With Feuil4
ecartANP = CA_ANP - .Cells(13, 9)
.Range("K14").Value = ecartANP
'MsgBox ecartANP
ecart2 = ecartANP
End With
Loop
'Application.ScreenUpdating = TrueCode qui s'exécute à l'intérieur de la boucle.
Je suppose que tu sais que tu n'utilises pas le nom de la feuille mais son nom de code (CodeName).
Compte tenu des affectations initiales, ecart1 et ecart2 sont inférieurs respectivement à valeur1 et valeur2 en entrée de boucle.
La sortie de boucle interviendra donc lorsque ecart1 et ecart2 deviendront positif.
La variation de leur valeur est induite exclusivement par la variation de TC_SM, à chaque tour de boucle.
Difficile d'avoir un avis sur la validité de tes calculs ! Pour l'instant on suppose que cette variation conduira à réunir la condition de sortie de boucle.
Y a-t-il problème : sortie prématurée de la boucle, ou non sortie de la boucle ?
Cordialement.
ok, le problème que j'ai maintenant est comment faire pour tomber dans ma solution 0<ecart1<v1 et 0<ecart2<v2, c'est à dire comment jouer sur mes 6 paramètres pour finalement trouver la solution. Maintenant j'essaye de fixer les 5 paramètres et faire changer une à chaque itération. j'ai mis une boocle do while sur un des paramètres pour calculer les ecarts mais apparemment je ne trouve pas le résultats, mon idée et à chaque fois je varie un des paramètres tout en fixons les autres. Est ce que vous avez d'autres pistes, idées..?
Function sumcode(rng As Range)
sumx = 0
For Each cell In rng
sumx = sumx + cell.Value
Next
sumcode = sumx
'MsgBox sumcode
End Function
Sub estimation()
Dim TC_SM As Single 'declaration des taux de cotisations pour SM et CAAD
Dim TC_CAAD As Single
Dim Max_SM, Max_CAAD As Long 'declaration des plafonds de cotisation pour SM et CAAD
Dim Min_SM, Min_CAAD As Long 'declaration des minimum de cotisation pour SM et CAAD
Dim ecart1, ecart2 As Long 'declaration des ecart BP - BA
Dim PPactifs_SM_MM, PPactifs_SM_ANP As Long 'declaration de la part patronale actifs pour SM pour MM et ANP
Dim PPactifs_CAAD_MM, PPactifs_CAAD_ANP As Long 'declaration de la part patronale actifs pour CAAD pour MM et ANP
Dim CA_MM, CA_ANP As Long
Dim min_seuil, max_seuil_MM, max_seuil_ANP As Long
Dim valeur1, valeur2 As Long
Dim i As Long
Dim ecartMM As Long
Dim ecartANP As Long
'ecartMM = -3637894.14
'ecartANP = -1105957
'i=0
TC_SM = 0.04
TC_CAAD = 0.008
Max_SM = 483.33
Min_SM = 0
Max_CAAD = 66.67
Min_CAAD = 0
Do While TC_SM < 0.06
TC_SM = TC_SM + 0.001
Feuil4.Select
Feuil4.Range("E4").Value = Max_SM
Feuil4.Range("E3").Value = TC_SM
Feuil4.Range("F3").Value = TC_CAAD
Feuil4.Range("F4").Value = Max_CAAD
Feuil4.Range("E5").Value = Min_SM
Feuil4.Range("F5").Value = Min_CAAD
CA_MM = Application.WorksheetFunction.Sum(Feuil2.Range("P25334").Value, Feuil2.Range("R25334").Value)
Feuil4.Range("E13").Value = CA_MM
ecartMM = CA_MM - Feuil4.Cells(13, 3).Value
Feuil4.Range("E14").Value = ecartMM
'MsgBox ecartMM
'CA ANP
CA_ANP = Application.WorksheetFunction.Sum(Feuil1.Range("P11083").Value, Feuil1.Range("R11083").Value)
'calcul de l'ecart MM
Feuil4.Range("K13").Value = CA_ANP
ecartANP = CA_ANP - Feuil4.Cells(13, 9)
Feuil4.Range("K14").Value = ecartANP
'MsgBox ecartANP
Loop
End SubSi pas de problème sur le fonctionnement de la macro, la question se transfère au niveau de ta gestion. Là ce n'est plus vraiment un problème Excel ou VBA (qui peut revenir plus tard pour traduire la solution que tu auras trouvée), il faut une connaissance suffisante des éléments de ton activité, des objectifs que tu dois atteindre et des moyens que tu peux ou non utiliser pour cela. Il n'y a en princicpe que toi qui peut répondre de façon effective à cette question, ou un collègue ou collaborateur connaissant au même degré la matière que tu traites.
Effectivement Mferrand tu as raison, en fait j'ai pu résoudre le problème manuellement sans avoir recours au Macro, la résolution du problème été difficile pour la machine. Merci pour votre aide.