En VBA il y a la fonction Evaluate qui prend en argument une formule énoncée dans une variable alphanumérique et renvoi le résultat dans une variable alphanumérique .
En VB, ça n'existe pas, il faut donc l'implémenter soi-même.
j'ai mis cette démo en astuces suite à une question sur le forum, je pense qu'elle peu servir à d'autre
Elle prend en charge les calculs simple +, -, *, et / ainsi que les parenthèses. Les fonctions sont faites de tel façon qu'il est très facile d'ajouter des type tel que Sqr ^ etc..
La démo fonctionne de la même façon que Evaluate, envoi de la formule en alphanumérique , retour du résultat en alphanumérique , type de calcul idem que sur l'image
Cette sub sert uniquement pour le test..
Sub TestCalcul()
Dim A As String
Dim Ret As String
A = "(((3*(12.223+ 15)) - 7)*21)/7"
Ret = Evaluer(A)
'Debug.Print Ret
'= 224.007
A = "((123.32/2.67)*6)+2127.34"
Ret = Evaluer(A)
'=2404.46359550562
'Debug.Print Ret
End Sub
Le code des fonctions
Function Evaluer(ByVal Txt As String) As String
Dim i As Integer, oNB As Integer, fNB As Integer
Dim P1 As Integer, P2 As Integer
Dim Buff As String
Dim T As String
'Pour les calculs y faut un point à la place de la virgule
Txt = Replace(Txt, ",", ".")
'Voir s'il y a des (
For i = 1 To Len(Txt)
If Mid(Txt, i, 1) = "(" Then oNB = oNB + 1
Next i
'S'il y a des ( (ouvrantes), voir si elle sont validée par des ) (fermantes)
If oNB > 0 Then
For i = 1 To Len(Txt)
If Mid(Txt, i, 1) = ")" Then fNB = fNB + 1
Next i
Else
'Pas de parenthèse, Evalue directement le calcul
Evaluer = EvalueExpression(Txt)
Exit Function
End If
If oNB <> fNB Then
'Les parenthèses ne sont pas concordantes, mettre message erreur parenthèse
Exit Function
End If
While oNB > 0
'recherche la dernière parenthèse ouvrante
P1 = InStrRev(Txt, "(")
'Recherche la parenthèse fermante de l'expression
P2 = InStr(Mid(Txt, P1 + 1), ")")
'Evalue l'expression qui est entre parenthèses
Buff = EvalueExpression(Mid(Txt, P1 + 1, P2 - 1))
'Remplacer l'expression par le résultat et supprimer les parenthèses
Txt = Left(Txt, P1 - 1) & Buff & Mid(Txt, P1 + P2 + 1)
oNB = oNB - 1
Wend
'plus de parenthèse, évaluer la dernière expression
Evaluer = EvalueExpression(Txt)
End Function
Function EvalueExpression(A As String) As String
Dim T As Integer, S As Integer
Dim B As String, i As Integer, C As Boolean
Dim c1 As Double, c2 As Double, Signe As Integer
Dim R As String, Fin As Boolean, z As Integer
'enlever les espace
A = Replace(A, " ", "")
While Not Fin
For i = 1 To Len(A)
T = Asc(Mid(A, i, 1))
If T < 48 And T <> 46 Or i = Len(A) Then
If C Then 'évalue
If i = Len(A) Then
c2 = Val(Mid(A, S))
Else
c2 = Val(Mid(A, S, i - S))
End If
R = Str(CalculSimple(c1, c2, Signe))
If i = Len(A) Then
Fin = True
Else
A = Trim(R & Mid(A, i))
C = False
End If
Exit For
Else 'sépare le 1er chiffre
c1 = Val(Left(A, i - 1))
Signe = T
S = i + 1
C = True
End If
End If
Next i
Wend
'remplacer l'expression par le résultat
EvalueExpression = Trim(R)
End Function
C'est dans la fonction ci-dessous qu'il est possible d'ajouter des calculs différents
Function CalculSimple(n1 As Double, n2 As Double, Signe As Integer) As Double
Select Case Signe
Case 43 ' +
CalculSimple = n1 + n2
Case 45 ' -
CalculSimple = n1 - n2
Case 42 ' *
CalculSimple = n1 * n2
Case 47 ' /
CalculSimple = n1 / n2
'Ici, ajouter d'autre calcul...
End Select
End Function
Note : Pour que cela concorde parfaitement avec une calculatrice il faudrait d'abord évaluer la fonction * et / et seulement ensuite les + et -
Exemple 3+5*7
Une calculatrice aura comme résultat 5*7 = 35 + 3 = 38
Ici cela donnera 3+5=8 *7 = 56
Vous pouvez éventuellement modifier la fonction "EvalueExpression" ou mettre le calcul sous la forme 3+(5*7) qui donnera 38.
Possible qu'il y ai des bugs dans certaines conditions,vous pouvez m'envoyer vos commentaires et ou report d'erreur en MP.
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
