Calculer une expression mathematique

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 155 fois - Téléchargée 66 fois

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

Ajouter un commentaire

Commentaires

bigbourin
Messages postés
64
Date d'inscription
lundi 12 avril 2004
Statut
Membre
Dernière intervention
18 août 2006
-
Houa !!!!!!!!!!
T'es vrémen un boss elle est exelente cette fonction.
sa fait un baille qu'elle est sur vb et je l'avais pas vu.
vrément bien merci.
10 / 10

bonne prog
cs_titou2002
Messages postés
50
Date d'inscription
mardi 17 septembre 2002
Statut
Membre
Dernière intervention
25 avril 2005
-
ouais il fo une recherche et une ecriture de la smplification pour les fraction
m'engin ya ka faire le pgcd (avec une fonction) et puis ca va tout seul
fo ke je voi lol
cs_Warning
Messages postés
517
Date d'inscription
samedi 3 février 2001
Statut
Modérateur
Dernière intervention
24 octobre 2006
1 -
bah en fait c plus simple que ça en a l'air :D ...

refléchie bien

bon le seul pb c avec les fractions... elle sont directment transformée...

bye, Warning
cs_titou2002
Messages postés
50
Date d'inscription
mardi 17 septembre 2002
Statut
Membre
Dernière intervention
25 avril 2005
-
pas mal lol et je pense ke bcp de collegiens vont s'en servir
je vojulais faire un truc comme ca aussi (lol c'est pareil pour tout les 3eme lol) mais ki donnerai les details des calculs (demander dans les exos) et avec plus de fonction, je partirai peut etre de ta source lol
vu ke je suis encore un newbie en prog ca va me prendre du temps lol
lyon2002
Messages postés
1
Date d'inscription
dimanche 19 janvier 2003
Statut
Membre
Dernière intervention
10 février 2003
-
bravo! pour le travail.

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.