Résultat d'une opération au format chaine de texte

Salmander

XLDnaute Occasionnel
Bonjour,
J’ai un fichier avec des opérations au format texte :
"4x5", "10/2", "43+15x3",…
J’aimerais obtenir le résultat de ces opérations.
Merci par avance.
 

Pièces jointes

  • Chaine.xlsx
    8.7 KB · Affichages: 47
Dernière édition:

david84

XLDnaute Barbatruc
Re : Résultat d'une opération au format chaine de texte

Bonsoir Modeste G, pierrejean, le forum,
ci-joint un fichier que j'avais commis il y a peu.
La fonction prend en compte des formules complexes, des plages nommées et des références à d'autres feuilles.
Je ne l'ai pas testée sur ton fichier mais tu peux regarder celui que j'ai joint.
Il y a sûrement des améliorations à apporter.
Dis-moi ce qu'il en est et j'apporterai les améliorations en fonction des tests que tu feras.
Code:
'Outils>Références>Cocher la librairie Microsoft VBScript Regular Expressions x.x
Option Explicit
Function FormuleNum(Chaine As Variant) As String
Dim sCopChaine As String, sFonction As String
Dim oRegExp As VBScript_RegExp_55.RegExp
Dim oRegExp2 As VBScript_RegExp_55.RegExp
Dim oMatches As VBScript_RegExp_55.MatchCollection
Dim oMatches2 As VBScript_RegExp_55.MatchCollection
Dim i As Byte, j As Byte
Dim NomDef As Names, LeNom As String
    
Application.Volatile 'pour les fonctions volatiles
If Chaine.HasFormula = True Then
    Chaine = Chaine.Formula
    
    'Remplacement des noms définis par leur référence de plage
    Set NomDef = ActiveWorkbook.Names
    If Not NomDef Is Nothing Then
        For j = 1 To NomDef.Count
            Chaine = Replace(Chaine, NomDef.Item(j).Name, Right(NomDef.Item(j).RefersTo, Len(NomDef.Item(j).RefersTo) - 1))
        Next j
    End If
    j = 0
    
    sCopChaine = Chaine
    
    Set oRegExp = New VBScript_RegExp_55.RegExp
    Set oRegExp2 = New VBScript_RegExp_55.RegExp
    
    oRegExp.Global = True
    oRegExp2.Global = True
    
    'Motif traitant les nombres non placés entre parenthèses
    oRegExp.Pattern = "(?:\=|\+|-|\*|/|^)\d+(?:\+|-|\*|/|^)"
    If oRegExp.test(sCopChaine) = True Then sCopChaine = oRegExp.Replace(sCopChaine, "")
    
    'Motif traitant les chaînes alphabétiques placées entre parenthèses
    oRegExp.Pattern = """\(\w+\)"""
    If oRegExp.test(sCopChaine) = True Then sCopChaine = oRegExp.Replace(sCopChaine, "")
    
    'Motif traitant les caractères placées entre parenthèses
    oRegExp.Pattern = "(?:=|\+|-|\*|/|^|,|[& ""]+)?(.*?\)+)"
    
    'Motif traitant les références aux cellules (style de référence A1)
    oRegExp2.Pattern = "(?:(?:'\s*)?\w+(?:\s*')?!)?\$?[A-Z]{1,3}\$?\d{1,7}"
    
    If oRegExp.test(sCopChaine) = True Then
        Set oMatches = oRegExp.Execute(sCopChaine)
        For i = 0 To oMatches.Count - 1
            If oMatches(i) Like "*[:,""]*" Or oMatches(i) Like "*()*" Then
fonction:
                If j = 0 Then sFonction = sFonction & oMatches(i).submatches(0) Else sFonction = sFonction & oMatches(i)
                On Error Resume Next
                Chaine = Replace(Chaine, sFonction, Evaluate(sFonction), , 1)
                If Err.Number <> 0 Then
                    On Error GoTo 0
                    j = j + 1: i = i + 1
                    GoTo fonction
                Else
                    sCopChaine = Replace(sCopChaine, sFonction, "", , 1): sFonction = "": j = 0
                End If
            Else
                If oRegExp2.test(oMatches(i)) = True Then
                    Set oMatches2 = oRegExp2.Execute(oMatches(i))
                    For j = 0 To oMatches2.Count - 1
                        Chaine = Replace(Chaine, oMatches2(j), Evaluate(CStr(oMatches2(j))), , 1)
                    Next j
                    sCopChaine = Replace(sCopChaine, oMatches(i), "", , 1): j = 0
                End If
            End If
        Next i
    Else
        If oRegExp2.test(sCopChaine) = True Then
            Set oMatches2 = oRegExp2.Execute(sCopChaine)
            For j = 0 To oMatches2.Count - 1
                Chaine = Replace(Chaine, oMatches2(j), Evaluate(CStr(oMatches2(j))), , 1)
            Next j
        End If
    End If
    FormuleNum = Chaine
    Set oRegExp = Nothing: Set oRegExp2 = Nothing
    Set oMatches = Nothing: Set oMatches2 = Nothing
End If
End Function
A+
 

Pièces jointes

  • Formule_chaine_texte.xls
    54 KB · Affichages: 44

Discussions similaires

Réponses
26
Affichages
810

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof