Routine de calcul

Commenter

Contenu du snippet

Bon, j'ai déjà écrit une routine de calcul. Celle là, c'est une nouvelle version, que je pense plus simple et plus courte. Bien sûr, il y a toujours des choses à ajouter.

Source / Exemple :

Public Function InstrInv(Depart As Integer, Chaine1 As String, Chaine2 As String) As Integer
Dim No As Integer

For No = Depart To Len(Chaine2) + 1 Step -1
    If Mid(Chaine1, No - Len(Chaine2), Len(Chaine2)) = Chaine2 Then
        InstrInv = No - Len(Chaine2)
        Exit Function
    End If
Next No
InstrInv = 0
End Function



Public Function Valeur(Data As String) As String
Dim Op(5) As String
Dim NbOp As Integer
    Op(0) = "^"
    Op(1) = "/"
    Op(2) = "*"
    Op(3) = "+"
    Op(4) = "ET"
    Op(5) = "OU"
    NbOp = 5        'Si on rajoute un opérateur, changer la variable
    
Dim Fonc(5) As String
Dim NbFonc As Integer
    Fonc(0) = "SIN("
    Fonc(1) = "COS("
    Fonc(2) = "TAN("
    Fonc(3) = "ABS("
    NbFonc = 3       'Si on ajoute des fonctions, changer la variable
Dim Debut, Fin As Integer
    
    'ReDim Preserve Variable(10) As Variables
    Dim Bcl1, Bcl2, Bcl3, Bcl4 As Integer
    Dim Nbr1, Nbr2 As Integer
    Dim NbrParO, NbrParF As Integer

Data = UCase(Data)
    If InStr(1, Data, "ERREUR") <> 0 Then
        Valeur = "ERREUR"
        Exit Function
    End If

'***********Calcul des Parentheses**************************
GoSub VerifPar
GoTo CalcFonc
VerifPar:
    NbrParO = 0
    NbrParF = 0
    Bcl1 = 0
        
        If InStr(1, Data, "(") > 0 And InStr(Bcl1 + 1, Data, ")") = 0 Then
            Valeur = "ERREUR"
            MsgBox "Erreur dans le nombre de parenthéses" + vbCrLf + "Verifiez qu'il n'y a pas d'espace mal positionnés", , "Erreur"
            Exit Function
        End If
    
        Do
            'Selectionne la parenthese suivante et la compte
            If InStr(Bcl1 + 1, Data, "(") < InStr(Bcl1 + 1, Data, ")") And InStr(Bcl1 + 1, Data, "(") > 0 Then
                NbrParO = NbrParO + 1
                Bcl1 = InStr(Bcl1 + 1, Data, "(")
            ElseIf InStr(Bcl1 + 1, Data, ")") > 0 Then
                NbrParF = NbrParF + 1
                Bcl1 = InStr(Bcl1 + 1, Data, ")")
            Else
                Bcl1 = 0
            End If

            'Test si il y a des erreurs dans le placement des parentheses
            If NbrParO - NbrParF < 0 Then
                Valeur = "ERREUR"
                MsgBox "Erreur dans le placement des parenthéses", , "Erreur"
                Exit Function
            End If
        Loop Until Bcl1 = 0
        
            'test si il y a des erreurs dans le nombre de parentheses
        If NbrParO - NbrParF <> 0 Then
            Valeur = "ERREUR"
            MsgBox "Erreur dans le nombre de parenthéses" + vbCrLf + "Verifiez qu'il n'y a pas d'espace mal positionnés", , "Erreur"
            Exit Function
        End If
Return

'**********************Calcul des fonctions****
CalcFonc:
For Bcl1 = 0 To NbFonc
    Bcl2 = 0
    
    Do Until InStr(Bcl2 + 1, Data, Fonc(Bcl1)) = 0
        Bcl2 = InStr(Bcl2 + 1, Data, Fonc(Bcl1))
        Debut = InStr(Bcl2 + 1, Data, "(") - 1
        Nbr1 = 0
        Nbr2 = 0
        Bcl3 = 0
        
        Do
            If InStr(Bcl3 + 1, Data, "(") < InStr(Bcl3 + 1, Data, ")") And InStr(Bcl3 + 1, Data, "(") > 0 Then
                Nbr1 = Nbr1 + 1
                Bcl3 = InStr(Bcl3 + 1, Data, "(")
            ElseIf InStr(Bcl3 + 1, Data, ")") > 0 Then
                Nbr2 = Nbr2 + 1
                Bcl3 = InStr(Bcl3 + 1, Data, ")")
            Else
                Bcl3 = 0
            End If
        Loop Until Nbr1 - Nbr2 = 0
        
        
        
        
        
'        Do Until InStr(Bcl3 + 1, Data, "(") > InStr(Bcl3 + 1, Data, ")") Or InStr(Bcl3 + 1, Data, "(") = 0
'            Nbr1 = Nbr1 + 1
'            Bcl3 = InStr(Bcl3 + 1, Data, "(")
'        Loop
                        
            
            Fin = Debut
            Debut = Debut + 1
            For Bcl4 = 1 To Nbr1
                Fin = InStr(Fin + 1, Data, ")")
            Next Bcl4
            'Fin = InStr(Fin, Data, ")")
            Select Case Fonc(Bcl1)
                Case "SIN(": Data = Left(Data, Debut - Len(Fonc(Bcl1))) + Str(Sin(Val(Valeur(Mid(Data, Debut + 1, Fin - Debut - 1))))) + Right(Data, Len(Data) - Fin) 'Effectue le calcul entre parenthese
                Case "COS(": Data = Left(Data, Debut - Len(Fonc(Bcl1))) + Str(Cos(Val(Valeur(Mid(Data, Debut + 1, Fin - Debut - 1))))) + Right(Data, Len(Data) - Fin) 'Effectue le calcul entre parenthese
                Case "TAN(": Data = Left(Data, Debut - Len(Fonc(Bcl1))) + Str(Tan(Val(Valeur(Mid(Data, Debut + 1, Fin - Debut - 1))))) + Right(Data, Len(Data) - Fin) 'Effectue le calcul entre parenthese
                Case "ABS(": Data = Left(Data, Debut - Len(Fonc(Bcl1))) + Str(Abs(Val(Valeur(Mid(Data, Debut + 1, Fin - Debut - 1))))) + Right(Data, Len(Data) - Fin) 'Effectue le calcul entre parenthese
            End Select
    Loop
        'Data = Valeur(Data) 'effectue le calcul final quand il n'y a plus de parenthese
Next Bcl1
    GoSub VerifPar

'**********************Modification à faire à la chaine****
'liste exhaustive
Dim Stg1 As String
Stg1 = "(*+/^-"
    
'recherche des doubles --
    Bcl1 = 0
    Do Until InStr(Bcl1 + 1, Data, "--") = 0
        Bcl1 = InStr(Bcl1 + 1, Data, "--")
                Data = Left(Data, Bcl1 - 1) + "+" + Mid(Data, Bcl1 + 2, Len(Data) - Bcl1 - 1)
    Loop

'Recherche du signe - dans la donnée
    Bcl1 = 0
    Do Until InStr(Bcl1 + 1, Data, "-") = 0
        Bcl1 = InStr(Bcl1 + 1, Data, "-")
        If Bcl1 <> 1 Then
                'remplace si presence d'un - sans operateur devant
            If InStr(1, Stg1, Mid(Data, Bcl1 - 1, 1)) = 0 Then Data = Left(Data, Bcl1 - 1) + "+-" + Mid(Data, Bcl1 + 1, Len(Data) - Bcl1)
        End If
    Loop

'Recherche du ( dans la donnée
    Stg1 = "*+-/"
    Bcl1 = 0
    Do Until InStr(Bcl1 + 1, Data, "(") = 0
        Bcl1 = InStr(Bcl1 + 1, Data, "(")
        If Bcl1 <> 1 Then
                'remplace si presence d'un ( sans operateur devant
            If InStr(1, Stg1, Mid(Data, Bcl1 - 1, 1)) = 0 Then Data = Left(Data, Bcl1 - 1) + "*(" + Mid(Data, Bcl1 + 1, Len(Data) - Bcl1)
        End If
    Loop

'Recherche du ) dans la donnée
    Stg1 = "*+-/"
    Bcl1 = 0
    Do Until InStr(Bcl1 + 1, Data, ")") = 0
        Bcl1 = InStr(Bcl1 + 1, Data, ")")
        If Bcl1 <> 1 Then
                'remplace si presence dun - sans operateur devant
            If InStr(1, Stg1, Mid(Data, Bcl1 + 1, 1)) = 0 Then Data = Left(Data, Bcl1 - 1) + ")*" + Mid(Data, Bcl1 + 1, Len(Data) - Bcl1)
        End If
    Loop


'**********************Calcul******************************
    Select Case NbrParO
        '**************Parenthèses*************************
        Case Is > 0:
            Do
            Fin = InStr(1, Data, ")")       'Cherche la 1ere parenthese fermé
            Debut = InstrInv(Fin, Data, "(") 'Cherche la parenthese ouverte correspondant à la parenthese fermé
            Data = Left(Data, Debut - 1) + Valeur(Mid(Data, Debut + 1, Fin - Debut - 1)) + Right(Data, Len(Data) - Fin)  'Effectue le calcul entre parenthese
            Loop Until InStr(1, Data, "(") = 0
    
            Data = Valeur(Data) 'effectue le calcul final quand il n'y a plus de parenthese
    
        
        
        '***********Sans parenthèses************************
        Case Is = 0:
            Dim Nbr(2) As String
            Dim Pos As Integer
            
            
            For Bcl1 = 0 To NbOp
                
                
                Do Until InStr(1, Data, Op(Bcl1)) = 0
                    
                    
                    '****Definition du premier terme****
                    Pos = InStr(1, Data, Op(Bcl1))
                    Debut = 1
                    For Bcl2 = 0 To NbOp
                        If InstrInv(Pos, Data, Op(Bcl2)) > Debut Then Debut = InstrInv(Pos, Data, Op(Bcl2)) + Len(Op(Bcl2))
                    Next Bcl2
                
                                        If InStr(1, Data, Op(Bcl1)) - Debut = 0 Then
                        Nbr(1) = "0"
                    Else
                        Nbr(1) = Mid(Data, Debut, Pos - Debut)
                    End If
                    
                    '****Definition du deuxieme terme****
                    Fin = Len(Data)
                    For Bcl2 = 0 To NbOp
                        If InStr(Pos + 1, Data, Op(Bcl2)) < Fin And InStr(Pos + 1, Data, Op(Bcl2)) > 0 Then Fin = InStr(Pos + 1, Data, Op(Bcl2)) - 1
                    Next Bcl2
                    If InStr(1, Data, Op(Bcl1)) - Fin = 0 Then
                        Valeur = "ERREUR"
                        Exit Function
                    End If
                
                    Nbr(2) = Mid(Data, Pos + Len(Op(Bcl1)), Fin + 1 - (Pos + Len(Op(Bcl1))))
                    '*****Calcul************************
                    Select Case Op(Bcl1)
                        Case "ET": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) And Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                        Case "OU": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) Or Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                        Case "^": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) ^ Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                        Case "/": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) / Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                        Case "*": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) * Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                        Case "+": Data = Left(Data, Debut - 1) + Trim(Str(Val(Nbr(1)) + Val(Nbr(2)))) + Right(Data, Len(Data) - Fin)
                    End Select
                Loop
            Next Bcl1
    End Select
    Valeur = Data

End Function

Conclusion :

Vous appelez la fonction Valeur en donnant à la variable Data la valeur d'une chaine de caractere correspondant à un calcul. Ne pas mettre de signe "=". La fonction Valeur renvoie le résultat sous la forme d'une chaine de caractere.
ex: "1+1" renvoie "2"

Il gere les parentheses, on peut en mettre tant qu'on veut, il gere les 4 opérateurs + - * /.
Il respecte les priorités
Il gere les fonctions SIN COS TAN, seulement si l'on s'en sert avec des parentheses
ex SIN(5)
Pour le reste, voyez le programme, il y a quelque commentaire.
ex de fonctionnement pour ceux qui ne savent pas se servir :
Dim Var1 as string
Var1= Valeur("UN calcul, n'importe lequel") 'Placer une chaine de caractere.

Maintenant, si parmis vous il y en a qui sont tentés, est-ce qu'ils peuvent m'améliorer cette routine, me la simplifier, la completer, la debugger(je ne crois pas qu'il y ait des erreurs)
et m'envoyer ça à
Laurent.jo@Wanadoo.fr
Vous seriez trop cool.

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_Johjo)