Calculer une expression mathematique

Commenter

Contenu du snippet

Permet de calculer une équation du type :
2*(V4*4²+(2*2))/8

Source / Exemple : 


Function Calcule(TheCalcul As String)
    Dim NewCalcul As String, ThePos As Long, Parenthese As String, CParenthese As String, NegPos As Long, NextPar As Long
    NewCalcul = Replace(TheCalcul, " ", "")
    NewCalcul = Replace(NewCalcul, ",", ".")
    NewCalcul = "0+" & NewCalcul & "+0"
    NewCalcul = UCase(NewCalcul)
    
    While InStrRev(1, NewCalcul, "(") <> Len(NewCalcul)    'Calcule les parenthèses
      ThePos = Len(NewCalcul) - InStrRev(1, NewCalcul, "(")
      NextPar = InStr(ThePos, NewCalcul, ")")
      Parenthese = Mid(NewCalcul, ThePos, NextPar - ThePos + 1)
      CParenthese = Calcule(Mid(Parenthese, 2, Len(Parenthese) - 2))
      NewCalcul = Mid(NewCalcul, 1, ThePos - 1) & CParenthese & Mid(NewCalcul, ThePos + Len(Parenthese), Len(NewCalcul) - (ThePos + Len(Parenthese)) + 1)
    Wend
    
    NewCalcul = Replace(NewCalcul, ",", ".")
        
    While InStr(1, NewCalcul, "²") <> 0    'Calcule les carrés
      ThePos = InStr(1, NewCalcul, "²")
      NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) ^ 2 & Mid(NewCalcul, ThePos + (GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos))
    Wend
    
    NewCalcul = Replace(NewCalcul, ",", ".")
        
    While InStr(1, NewCalcul, "V") <> 0    'Calcule les racines carrés
      ThePos = InStr(1, NewCalcul, "V")
      NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & Sqr(Val(Mid(NewCalcul, ThePos + 1, GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos))
    Wend
    
    NewCalcul = Replace(NewCalcul, ",", ".")
    
    If InStr(1, NewCalcul, "*") < InStr(1, NewCalcul, "/") Then    'Calcule les multiplications et les divisions
      While InStr(1, NewCalcul, "*") <> 0
        ThePos = InStr(1, NewCalcul, "*")
        NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) * Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
      Wend
      
      NewCalcul = Replace(NewCalcul, ",", ".")
          
      While InStr(1, NewCalcul, "/") <> 0
        ThePos = InStr(1, NewCalcul, "/")
        NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) / Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
      Wend
    Else
      While InStr(1, NewCalcul, "/") <> 0
        ThePos = InStr(1, NewCalcul, "/")
        NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) / Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
      Wend
      
     NewCalcul = Replace(NewCalcul, ",", ".")
      
      While InStr(1, NewCalcul, "*") <> 0
        ThePos = InStr(1, NewCalcul, "*")
        NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) * Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
      Wend
    End If
    
    NewCalcul = Replace(NewCalcul, ",", ".")
        
    Calcule = Addition(NewCalcul)    'Additionne le tout
End Function

Function InStrRev(Start As Long, String1 As String, String2 As String)
    InStrRev = Len(String1)
    For i = 1 To Len(String1) - Start
      If Mid(String1, Len(String1) - Start - i + 1, Len(String2)) = String2 Then InStrRev = Start + i - 1: Exit Function
    Next i
End Function

Function GetSeparatorRev(Start As Long, TheString As String)
    Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
    
    VAdd = InStr(Start, TheString, "+")
    VDiv = InStr(Start, TheString, "/")
    VMul = InStr(Start, TheString, "*")
    VRac = InStr(Start, TheString, "V")
    VSou = InStr(Start, TheString, "-")
    
    If VAdd = 0 Then
      VAdd = Len(TheString) + 1
    End If
    If VDiv = 0 Then
      VDiv = Len(TheString) + 1
    End If
    If VMul = 0 Then
      VMul = Len(TheString) + 1
    End If
    If VRac = 0 Then
      VRac = Len(TheString) + 1
    End If
    If VSou = 0 Then
      VSou = Len(TheString) + 1
    End If
    
    If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
      GetSeparatorRev = VAdd
    ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
      GetSeparatorRev = VDiv
    ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
      GetSeparatorRev = VRac
    ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
      GetSeparatorRev = VSou
    Else
      GetSeparatorRev = VMul
    End If
End Function
Function GetSeparatorSP(Start As Long, TheString As String)
    Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
    
    VAdd = InStr(Start, TheString, "+")
    VDiv = InStr(Start, TheString, "/")
    VMul = InStr(Start, TheString, "*")
    VRac = InStr(Start, TheString, "V")
    VSou = InStr(Start, TheString, "-")
    
    If VAdd = 0 Then
      VAdd = Len(TheString) + 1
    End If
    If VDiv = 0 Then
      VDiv = Len(TheString) + 1
    End If
    If VMul = 0 Then
      VMul = Len(TheString) + 1
    End If
    If VRac = 0 Then
      VRac = Len(TheString) + 1
    End If
    If VSou - Start = 0 Or VSou = 0 Then
      VSou = Len(TheString) + 1
    End If
    
    If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
      GetSeparatorSP = VAdd
    ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
      GetSeparatorSP = VDiv
    ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
      GetSeparatorSP = VRac
    ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
      GetSeparatorSP = VSou
    Else
      GetSeparatorSP = VMul
    End If
    

End Function
Function GetSeparator(Start As Long, TheString As String)
    Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
    
    VAdd = InStrRev(Start, TheString, "+")
    VDiv = InStrRev(Start, TheString, "/")
    VMul = InStrRev(Start, TheString, "*")
    VRac = InStrRev(Start, TheString, "V")
    VSou = InStrRev(Start, TheString, "-")
    
    If VAdd = 0 Then
      VAdd = Len(TheString) + 1
    End If
    If VDiv = 0 Then
      VDiv = Len(TheString) + 1
    End If
    If VMul = 0 Then
      VMul = Len(TheString) + 1
    End If
    If VRac = 0 Then
      VRac = Len(TheString) + 1
    End If
    If VSou = 0 Then
      VSou = Len(TheString) + 1
    End If
    
    If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
      GetSeparator = VAdd
    ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
      GetSeparator = VDiv
    ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
      GetSeparator = VRac
    ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
      GetSeparator = VSou
    Else
      GetSeparator = VMul
    End If
End Function

Public Function Replace(ByVal laChaine As String, ByVal old_car As String, ByVal new_car As String) As String
    Dim ncar As Integer, lng As Integer, result As String, txt As String
    lng = Len(old_car)
    txt = laChaine
    If lng <= 0 Then
        Replace = txt
        Exit Function
    End If
    On Error GoTo ErrChangeCaractre
    
    If lng <= 0 Or Len(Trim(txt)) <= 0 Then
        Replace = txt
        Exit Function
    End If
    result = vbNullString
    ncar = InStr(txt, old_car)
    Do While ncar
        If Len(result) > 0 Then
            If lng > 1 Then
                If ncar = 1 Then
                    result = result & new_car
                Else
                    result = result & Left(txt, ncar - 1) & new_car
                End If
            Else
                result = result & Left(txt, ncar - 1) & new_car
            End If
        Else
            result = Left(txt, ncar - 1) & new_car
        End If
        If lng > 1 Then
            txt = Right(txt, Len(txt) - ncar - (lng - 1))
        Else
            txt = Right(txt, Len(txt) - ncar)
        End If
        ncar = InStr(txt, old_car)
    Loop
    If Len(txt) > 0 Then result = result & txt
    Replace = result
    Exit Function
ErrChangeCaractre:
    Replace = result
End Function

Function Addition(TheCalcule As String)
    Dim NextC, i As Long
    NextC = Val(Mid(TheCalcule, 1, GetSeparatorRev(1, TheCalcule)))
    TheCalcule = Replace(TheCalcule, "+-", "-")
    TheCalcule = Replace(TheCalcule, "--", "+")
    TheCalcule = Replace(TheCalcule, "++", "+")
    For i = 1 To Len(TheCalcule)
      If Mid(TheCalcule, i, 1) = "+" Then
        NextC = NextC + Val(Mid(TheCalcule, i + 1, Len(TheCalcule) - GetSeparatorRev(i, TheCalcule)))
      ElseIf Mid(TheCalcule, i, 1) = "-" Then
        NextC = NextC - Val(Mid(TheCalcule, i + 1, Len(TheCalcule) - GetSeparatorRev(i, TheCalcule)))
      End If
    Next i
    Addition = NextC
End Function

Conclusion :


Exemple :
Calcule("2*(V16)") 'renvoie 8

V --> Racine Carré
² --> Carré
  • --> Multiplier

/ --> Diviser
+ --> Additioner
- --> Soustraire
( --> Parenthèse

Mettez vos commentaire (il contient surement quelque bug, merci de me prevenir)...

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Warning)