'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