[VB] Evaluer une expression mathématique d'un string
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.