Somme de coefficient égale à 100

Question

Je suis actuellement en formation contrôle de gestion, Nous avons donc commencé le VBA, et pour progresser, je fais des exercices moi-même. Mais je bloque complétement sur celui-ci: Exercice 6 Veuillez réaliser un programme demandant à l’utilisateur de rentrer la valeur numérique de 4 coefficients (entiers) dont la somme doit être égale à 100, la saisie devant se faire via des boites de dialogue. Lors de la saisie du 4ème coefficient, le programme propose automatiquement la valeur permettant à la somme des 4 coefficients d’arriver à la valeur 100. Ces coefficients sont mémorisés respectivement dans les cellules A2, B2, C2 et D2. Le programme vérifie en permanence que la somme des coefficients entrés n’excède pas 100. Si cette somme excède 100, le programme demande à l’utilisateur de recommencer, soit de rentrer les quatre coefficients. Je ne sais pas comment faire pour vérifier qu'à chaque coefficient saisie je contrôle que la somme soit &lt; 100 et sinon retourner à la première saisie... Merci de votre aide...

Invité · Answer

Merci de joindre le fichier que tu as déjà réalisé, normalement. @+...

3GB · Answer

Voici un essai : Sub Coeff() dim i% dim reponse as double, vdefaut as double, somme as double for i = 1 to 4 if i &lt; 4 then vdefaut = "" else vdefaut = 100 - somme 'si i &lt; 4, valeur par defaut est vide, sinon elle vaut 100 - somme des entrées reponse = inputbox("Entrez le coefficient n° " & i, "Saisie des coefficients", vdefaut) 'renvoie de la saisie (avec vdefaut dans inputbox) if not isnumeric(reponse) or reponse &lt;=0 or reponse &gt;= 100 then 'si mauvaise saisie, sortie msgbox "saisie incorrecte, veuillez réessayer", vbcritical exit sub end if cells(2, i).value = reponse 'valeur reprise en cellule A2 à D2 somme = somme + reponse 'actualisation de la somme (vaut 0 à la 1e itération) if i &lt; 4 then 'si i &lt; 4 if somme &gt;= 100 then 'si somme &gt;= 100, sortie (adapter si coeff peut valoir 0) et contenus effacés msgbox "Dépassement du plafond", vbcritical range("A2:C2").clearcontents exit sub end if else if somme &lt;&gt; 100 then 'sinon, si i = 4, si somme differente de 100, sortie et contenus effacés msgbox "Dépassement du plafond", vbcritical range("A2:D2").clearcontents exit sub end if end if next i Msgbox "Coefficients archivés en ligne 2" 'si boucle réalisée sans sortie, message confirmation end sub Cdlt...

3GB · Answer

Et un second essai s'il faut continuer jusqu'à obtenir une somme à 100 :

Sub Coeff()

dim i%
dim reponse as double, vdefaut as double, somme as double

while somme <> 100
    if i > 0 then 'si i > 0, cad si ce n'est pas la 1ere tentative
        somme = 0 'reinitialisation somme
        range("A2:D2").clearcontents 'contenus effacés
        if not msgbox("Réessayer ?", vbyesno) = vbyes then exit sub 'demande si on continue, si oui, reprise, sinon, sortie
    end if
    for i = 1 to 4
        if i < 4 then vdefaut = "" else vdefaut = 100 - somme 'si i < 4, valeur par defaut est vide, sinon elle vaut 100 - somme des entrées
        reponse = inputbox("Entrez le coefficient n° " & i, "Saisie des coefficients", vdefaut) 'renvoie de la saisie (avec vdefaut dans inputbox)
        if not isnumeric(reponse) or reponse <=0 or reponse >= 100 then 'si mauvaise saisie, sortie
            msgbox "saisie incorrecte, veuillez réessayer", vbcritical
            exit for
        end if
        cells(2, i).value = reponse 'valeur reprise en cellule A2 à D2
        somme = somme + reponse 'actualisation de la somme (vaut 0 à la 1e itération)
        if i < 4 then 'si i < 4
            if somme >= 100 then 'si somme >= 100, sortie (adapter si coeff peut valoir 0) et contenus effacés
                msgbox "Dépassement du plafond", vbcritical
                exit for
            end if
        else
            if somme <> 100 then 'sinon, si i = 4, si somme differente de 100, sortie et contenus effacés
                msgbox "Dépassement du plafond", vbcritical
                exit for
            end if
        end if  
    next i
wend

Msgbox "Coefficients archivés en ligne 2" 'si boucle réalisée sans sortie, message confirmation

end sub

Cdlt,

Invité · Answer

Une autre solution avec saisie obligatoire de chiffre Sub co() Dim Ind As Integer Dim Coef(4) As Single, Calcul As Single, Reste As Single Dim FlgOk As Boolean ' Flag d'erreur de saisie SaisieCoef: Calcul = 0: Reste = 0 ' Demander la saisie des 4 coefficients For Ind = 1 To 4 ' Si saisie du 4ème coef, donner le reste par défaut If Ind = 4 Then Reste = 100 - Calcul ' Demander la saisie Coef(Ind) = Application.InputBox("Merci de saisir le " & Ind _ & IIf(Ind = 1, "er", "ème") & " coefficient", _ Title:="Saisie totale = " & Calcul & "/100", _ Default:=Reste, Type:=1) ' Calculer le total Calcul = Calcul + Coef(Ind) ' Vérifier la saisie If Calcul &gt; 100 Then MsgBox "Saisie impossible, le total dépasse les 100%", vbCritical, "OUPS..." FlgOk = False: Exit For Else ' C'est ok, on enregistre la valeur Cells(2, Ind) = Coef(Ind) FlgOk = True End If Next Ind ' Vérifier le flag de saisie If FlgOk = False Then GoTo SaisieCoef ' Sinon c'est fini MsgBox "Merci pour votre saisie", vbInformation, "C'EST FINI" End Sub @+...

3GB · Answer

Oui, en effet, l'erreur vient de là.

J'ai adapté mon code en m'inspirant de celui de Bruno (notamment pour contraindre le type, merci !) :

Sub Coeff()

dim i%
dim reponse as double, vdefaut as double, somme as double

while somme <> 100
    if i > 0 then 'si i > 0, cad si ce n'est pas la 1ere tentative
        somme = 0 'reinitialisation somme
        range("A2:D2").clearcontents 'contenus effacés
        if not msgbox("Réessayer ?", vbyesno) = vbyes then exit sub 'demande si on continue, si oui, reprise, sinon, sortie
    end if
    for i = 1 to 4
        if i < 4 then vdefaut = 0 else vdefaut = 100 - somme 'si i < 4, valeur par defaut est vide, sinon elle vaut 100 - somme des entrées
        reponse = inputbox("Entrez le coefficient n° " & i, "Saisie des coefficients", vdefaut,,,,,1) 'renvoie de la saisie (avec vdefaut dans inputbox)
        if reponse <=0 or reponse >= 100 then 'si mauvaise saisie, sortie
            msgbox "saisie incorrecte, veuillez réessayer", vbcritical
            exit for
        end if
        cells(2, i).value = reponse 'valeur reprise en cellule A2 à D2
        somme = somme + reponse 'actualisation de la somme (vaut 0 à la 1e itération)
        if i < 4 then 'si i < 4
            if somme >= 100 then 'si somme >= 100, sortie (adapter si coeff peut valoir 0) et contenus effacés
                msgbox "Dépassement du plafond", vbcritical
                exit for
            end if
        else
            if somme <> 100 then 'sinon, si i = 4, si somme differente de 100, sortie et contenus effacés
                msgbox "La somme des coefficients ne vaut pas 100", vbcritical
                exit for
            end if
        end if  
    next i
wend

Msgbox "Coefficients archivés en ligne 2" 'si boucle réalisée sans sortie, message confirmation

end sub

Ce n'est pas testé mais a priori il recommence lorsque la somme est différente de 100.

Cdlt,

3GB · Answer

Alors, code essayé et fonctionnel chez moi avec la contrainte cependant de n'avoir aucun coefficient nul. Ce détail est à voir... L'erreur provient du fait qu'il y a une méthode inputbox et une fonction inputbox qui n'ont pas exactement les mêmes paramètres. Donc ma rectification calquée sur la proposition du Bruno était toujours bloquante. Voici le code : Sub Coeff() Dim i% Dim reponse As Double, vdefaut As Double, somme As Double While somme &lt;&gt; 100 Or i &lt; 4 If i &gt; 0 Then 'si i &gt; 0, cad si ce n'est pas la 1ere tentative somme = 0 'reinitialisation somme Range("A2:D2").ClearContents 'contenus effacés If Not MsgBox("Réessayer ?", vbYesNo) = vbYes Then Exit Sub 'demande si on continue, si oui, reprise, sinon, sortie End If For i = 1 To 4 If i &lt; 4 Then vdefaut = 0 Else vdefaut = 100 - somme 'si i &lt; 4, valeur par defaut est vide, sinon elle vaut 100 - somme des entrées reponse = Application.InputBox("Entrez le coefficient n° " & i, "Saisie des coefficients", vdefaut, , , , , 1) 'renvoie de la saisie (avec vdefaut dans inputbox) If reponse &lt;= 0 Or reponse &gt;= 100 Then 'si mauvaise saisie, sortie MsgBox "saisie incorrecte, veuillez réessayer", vbCritical Exit For End If Cells(2, i).Value = reponse 'valeur reprise en cellule A2 à D2 somme = somme + reponse 'actualisation de la somme (vaut 0 à la 1e itération) If i &lt; 4 Then 'si i &lt; 4 If somme &gt;= 100 Then 'si somme &gt;= 100, sortie (adapter si coeff peut valoir 0) et contenus effacés MsgBox "Dépassement du plafond", vbCritical Exit For End If Else If somme &lt;&gt; 100 Then 'sinon, si i = 4, si somme differente de 100, sortie et contenus effacés MsgBox "La somme des coefficients ne vaut pas 100", vbCritical Exit For End If End If Next i Wend MsgBox "Coefficients archivés en ligne 2" 'si boucle réalisée sans sortie, message confirmation End Sub Cdlt...

3GB · Answer

J'ai pas compris ? Le but serait d'empêcher la saisie de nombre décimaux ?

Si c'est le cas, dernier (et je l'espère ultime) essai :

Sub Coeff()

Dim i%
Dim reponse, vdefaut As Integer, somme As Integer

'Range("A2:D2").ClearContents 'contenus effacés à chaque lancement

While somme <> 100 Or i < 4
    If i > 0 Then 'si i > 0, cad si ce n'est pas la 1ere tentative
        somme = 0 'reinitialisation somme
        Range("A2:D2").ClearContents 'contenus effacés
        If Not MsgBox("Réessayer ?", vbYesNo) = vbYes Then Exit Sub 'demande si on continue, si oui, reprise, sinon, sortie
    End If
    For i = 1 To 4
        If i < 4 Then vdefaut = 0 Else vdefaut = 100 - somme 'si i < 4, valeur par defaut est vide, sinon elle vaut 100 - somme des entrées
        reponse = Application.InputBox("Entrez le coefficient n° " & i, "Saisie des coefficients", vdefaut) 'renvoie de la saisie (avec vdefaut dans inputbox)
        if IsNumeric(reponse) then if reponse <> int(reponse) then reponse = -1 'si décimal, passer reponse en negatif (pour renvoyer erreur)
        If Not IsNumeric(reponse) Or reponse <= 0 Or reponse >= 100 Then 'si mauvaise saisie, sortie
            MsgBox "saisie incorrecte, veuillez réessayer", vbCritical
            Exit For
        End If
        Cells(2, i).Value = reponse 'valeur reprise en cellule A2 à D2
        somme = somme + reponse 'actualisation de la somme (vaut 0 à la 1e itération)
        If i < 4 Then 'si i < 4
            If somme >= 100 Then 'si somme >= 100, sortie (adapter si coeff peut valoir 0) et contenus effacés
                MsgBox "Dépassement du plafond", vbCritical
                Exit For
            End If
        Else
            If somme <> 100 Then 'sinon, si i = 4, si somme differente de 100, sortie et contenus effacés
                MsgBox "La somme des coefficients ne vaut pas 100", vbCritical
                Exit For
            End If
        End If
    Next i
Wend

MsgBox "Coefficients archivés en ligne 2" 'si boucle réalisée sans sortie, message confirmation

End Sub

Cdlt,

3GB · Answer

Avez-vous testé le code ? A ma connaissance, il n'existe pas de fonction testant si le nombre est un entier. J'ai donc mis la ligne : if IsNumeric(reponse) then if reponse &lt;&gt; int(reponse) then reponse = -1 'si décimal, passer reponse en negatif (pour renvoyer erreur) Si la saisie est numérique, alors si la partie entière du nombre est différente du nombre, alors la variable reponse vaut -1 et conduira à sortir de la boucle à la condition suivante. Cdlt...