[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. Ce document intitulé « [VB] Evaluer une expression mathématique d'un string » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.