Icône de la ressource

fonction pour convertir une chaîne string représentant un nombre en chaîne numérique 1.6

Bonjour a tous
Dans la lignée des mes fonction nombre en lettres
que l'on trouve ici
ou encore par là en US
je vous propose aujourd'hui la fonction inverse
c'est a dire partir d'une chaîne string représentant une somme en euro ou un nombre et de le convertir en chaîne numérique
les langues disponibles sont français , suisse , Belgique , US ou anglo-saxon
elles sont automatiques la fonction va reconnaître toute seule la langue de la chaine
j'ai ajouté la permission au fautes d'orthographes et de grammaire (en effet l’écriture des nombres en lettres peut varier selon les métiers
la fonction converti aussi les sommes tout court sans monnaie euro
elle reconnait les séparateurs (euro ,euros, euros et , euro et ,virgule , ",")
remerciement au personnes qui ont testé
@Phil69970 , @Usine à gaz , @M12 , @Yeahou , @phil66

c'est une fonction que je n'avais jamais fini voilà qui est fait
VB:
'*************************************
'nombre lettre to nombre en numerique
'auteur :patricktoulon
'version1.3 17/06/2019
'version finale 1.6 30/11/2021
'mise ajour
'ajout de la prise en charge des centimes 29/11/2021
' ajout de  de plusieur syntaxes autorisée
'ajout de la suisse et la belgique
'ajout de US et l'anglosaxon
'************************************
Option Explicit
Sub test()
    MsgBox NblettreToNum("nine hundred ninety four euro and eighty five centimes")    'US
    MsgBox NblettreToNum("quatre-vingt-trois euro et cinquante-huit centimes")    'FR
    MsgBox NblettreToNum("huitante-trois euro et cinquante-huit centimes")    'Suisse
    MsgBox NblettreToNum("nonante-trois euro et cinquante-huit centimes")    'Belgique
End Sub

Function NblettreToNum(chaine As String, Optional region As String = "fr")
    Dim Lettres, chiffre, tranche, tranchenum, x, z&, i&, a&, t, q&, tc, StringOper, calcul, divi&

    Lettres = Array("zero", "un", "one", "deux", "two", "trois", "three", "quatre", "four", "cinq", "five", "six", "six", "sept", "seven", "huit", "eight", _
                    "neuf", "nine", "dix", "ten", "onze", "eleven", "douze", "twelve", "treize", "thirteen", "quatorze", "fourteen", "quinze", "fifteen", _
                    "seize", "sixteen", "dix-sept", "seventeen", "dix-huit", "eighteen", "dix-neuf", "nineteen", "vingt", "twenty", "trente", "thirty", _
                    "quarante", "fourty", "cinquante", "fifty", "soixante", "sixty", "soixante dix", "seventy", "septante", "quatrevingt", "eighty", _
                   "huitante", "octante", "quatrevingtdix", "ninety", "nonante", "cent", "cents")
    chiffre = Array(0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, _
                    19, 19, 20, 20, 30, 30, 40, 40, 50, 50, 60, 60, 70, 70, 70, 80, 80, 80, 80, 90, 90, 90, 100, 100)

    tranche = Array("mille", "million", "milliard"): tranchenum = Array("*1000" & vbCrLf, "*1000000" & vbCrLf, "*1000000000" & vbCrLf)
    x = Application.Trim(LCase(chaine))
    'nettoyage grammatical FR
    For i = 4 To UBound(Lettres): x = Replace(x, Lettres(i) & "s", Lettres(i)): Next    'pour les "s" des nombres en lettres
    x = Replace(Replace(Replace(Replace(x, "€uro", "euro"), "hundred", "cent"), " and ", " et "), "thousand", "mille")
    If x Like "*centime*" And Not x Like "*euro*" Then divi = 100
    If x Like "*centime*" And x Like "*,*" Then divi = 1
    x = Replace(Replace(Replace(Replace(x, "euros", "euro"), "zéro", "zero"), "-", " "), "euro et", ",")
    If Right(x, 4) = "euro" Then x = Replace(x, "euro", "")
    If Mid(x, InStr(1, x, "euro") + 2) <> "" Then x = Replace(x, "euro", ",")
    x = Replace(Replace(Replace(Replace(Replace(Replace(x, "virgule", ","), "virgule", ","), " et ", " "), "d'", " "), "euro", ""), "€", "")
    x = Replace(Replace(Replace(Replace(x, "quatre vingts", "quatrevingt"), "quatre vingt", "quatrevingt"), "centimes", ""), "centime", "")    'cas particulier de quatr vingt(s)
    For i = 0 To UBound(tranche): x = Replace(x, tranche(i), tranchenum(i)): Next

    x = Split(Application.Trim(x), ",")
    For z = 0 To UBound(x)
        'on a les tranches
        t = Split(x(z), vbCrLf)
        For i = 0 To UBound(t)
            tc = Split(Application.Trim(t(i)), " ")
            For a = 0 To UBound(tc)
                If tc(0) = "cent" Then tc(0) = 100
                If InStr(1, tc(a), "cent") = 0 Then
                    q = Application.IfError(Application.Match(tc(a), Lettres, 0), 0)
                    If q > 0 Then tc(a) = IIf(a > 0, "+", "") & chiffre(q - 1)
                Else
                    tc(a - 1) = Val(tc(a - 1)) * 100: tc(a) = ""
                End If
            Next
            t(i) = Join(tc)
            If InStr(1, t(i), "*") > 0 Then t(i) = "(" & Replace(t(i), "*", ")*")
            t(i) = "(" & t(i) & ")"
        Next
        StringOper = Replace((Replace(Replace(Join(t, "+"), "+()", ""), "()*", "")), " ", "")
        calcul = calcul + IIf(z = 1, Evaluate(StringOper) / 100, Evaluate(StringOper))
        'Debug.Print chaine & vbCrLf; "l'operation " & IIf(z = 0, "entier", "centime") & vbCrLf & StringOper & vbCrLf & "Résultat " & calcul
        StringOper = ""
    Next
    'Debug.Print "**********************************"
    If divi = 100 Then calcul = calcul / 100
    NblettreToNum = calcul
End Function

je depose un fichier mais tout la fonction est là
Auteur
patricktoulon
Version
1.6