Probleme de math (VBA)

Bonjour

j'ai essayé d'obtenir les solutions du probleme suivant via un bout de code que j'ai crée:

3 personnes terminent un jeu qui s'est deroulé en 5 manches , ils ont joués avec des pièces de 1€ et n'ont donc eu au cours de la partie que des sommes entieres , à chaque manche le perdant à doublé les avoirs des deux autres joueurs , à la fin de la partie

l'un a 8€ , l'autre 9€ et le dernier 10€ , on demande combien avait chacun au début ?

p = InputBox("saisir le 1ier montant pair:")
q = InputBox("saisir le 2ième montant pair:")
r = InputBox("saisir le 3ième montant impair:")
For u = 1 To 5

s = Val(p) + Val(q) + Val(r)

 t = Array(p, q, r)
x = ""
z = ""
y = 0
For i = 0 To UBound(t)
 If t(i) Mod 2 = 0 Then
 x = x & " " & t(i) / 2 'recuperation des valeurs paires
 y = 1 * y + (t(i) / 2)
 End If
Next
 z = (s - y) & x
 MsgBox z   '<---- les fonds de chacun a la fin de la manche u
 h = Split(z, " ")
 p = 1 * h(0)
 q = 1 * h(1)
 r = 1 * h(2)
 Next

les solutions retournées sont les fonds de chacun à la fin de chaque manque ( manche 5 à manche 1)

Peut on encor optimiser le code dans son ensemble , Merci à vous

Bonjour,

Une proposition :

Sub AvoirInit(nbJx As Integer, nbJ As Integer, ParamArray avoir())
    Dim i%, j%, g%, x%, msg$
    For i = 1 To nbJx
        For j = 0 To nbJ - 1
            If avoir(j) Mod 2 = 0 Then
                avoir(j) = avoir(j) / 2: g = g + avoir(j)
            Else
                x = j
            End If
        Next j
        avoir(x) = avoir(x) + g: g = 0
    Next i
    For i = nbJ - 1 To 0 Step -1
        msg = Chr(10) & i + 1 & " - " & avoir(i) & msg
    Next i
    msg = "Avoir initial de chaque joueur :" & Chr(10) & msg
    MsgBox msg
End Sub

Sub Test()
    AvoirInit 5, 3, 8, 9, 10
End Sub

Cordialement.

Merci Mferrand , je vais tester votre proposition ...