Autres evaluate qui donne une erreur en dynamique et bonne encodé en dur

patricktoulon

XLDnaute Barbatruc
bonsoir a tous
j'ai un petit soucis avec evaluate
il me donne une erreur codé en dynamique et me donne le resultat ecrit en dur

VB:
Option Explicit

Sub test()
    Dim x$

    x = "cent mille"
    MsgBox NbLettreToNumeric(x)

    x = "un million"
    MsgBox NbLettreToNumeric(x)

    x = "neuf cent soixante six milliards cinq cent soixante-neuf millions six cent cinquante-cinq mille quatre cent dix-huit Euros "
    MsgBox NbLettreToNumeric(x)
End Sub

Function NbLettreToNumeric(x As String)

    Dim Lettres, Chiffre, unitM, Multipl, i&, Segments, m&, s$, ch, c&, ind&, z#, texte$, tb

    Lettres = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", _
                    "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix", "cent", _
                    "mille", "million", "milliard", "mille", "millions", "milliards")

    Chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90, "*100", "*1000|", "*1000000|", "*1000000000|", "*1000|", "*1000000|", "*1000000000|")

    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "Euros", ""), "Euro", "")
    x = Replace(x, "-", " ")

    ch = Split(Application.Trim(x), " ")
    For c = LBound(ch) To UBound(ch)
        ind = WorksheetFunction.Match(ch(c), Lettres, 0) - 1
        s = Trim(s) & " " & Chiffre(ind) & "+"
        s = Replace(s, "+ *", "*")

        s = IIf(Left(s, 1) = "*", 1 & s, s)
    Next c
    s = s & "0"
    tb = Split(s, "|")
    For i = 0 To UBound(tb)
        texte = texte & "(" & Replace(tb(i), "*1000", ")*1000") & "+"
        texte = Replace(Replace(texte, "+ )", ")"), "(+", "(")
    Next
    'NbLettreToNumeric = Evaluate(texte)

    Debug.Print Replace(texte, " ", "") & "0)"

    Debug.Print Evaluate(Replace(texte, " ", ""))
    Debug.Print "---------------------------------------------"

End Function

'pour tant ici ca match '
Sub test2()
    MsgBox Evaluate("(9*100+ 60+ 6)*1000000000+( 5*100+ 60+ 9)*1000000+( 6*100+ 50+ 5)*1000+( 4*100+ 10+ 8+0+0)")
End Sub
des idées??? ;)
 
Solution
1580032428991.png


Patrick essayé cette correction ici de votre code poste #7
1580033013072.png


resultat :
1580033860391.png

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Patrick,
Je ne sais pas où se trouve l'erreur mais je sais pourquoi. ;)

Si vous insérer cette ligne de code [D5]=.... :
VB:
    Debug.Print "---------------------------------------------"
    [D5] = Replace(texte, " ", "")
End Function

Code:
Vous obtenez en D5 :

(9*100+60+6)*1000000000+(5*100+60+9)*1000000+(6*100+50+5)*1000+(4*100+10+8+0+

au lieu de :

(9*100+ 60+ 6)*1000000000+( 5*100+ 60+ 9)*1000000+( 6*100+ 50+ 5)*1000+( 4*100+ 10+ 8+0+0)

Si vous terminez cette equation en mettant "0)" alors vous obtenez le bon résultat.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
J'ai tenté autre chose de simple :
Code:
Sub test()
    Dim x$
    x = "un"
    MsgBox NbLettreToNumeric(x)
End Sub
avec un point d'arrêt sur EndFunction juste après la ligne [D5]=...
et j'obtiens en D5 : (1+0+
Il y a toujours un "+" à la fin en trop, et il manque la ")".

Désolé de ne pas plonger dans code, je n'en ai pas le courage ce soir.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Le problème est qu'en sortant de la boucle For, on a un + à la fin.
D'où une possible solution :
VB:
.....
For i = 0 To UBound(tb)
        texte = texte & "(" & Replace(tb(i), "*1000", ")*1000") & "+"
        texte = Replace(Replace(texte, "+ )", ")"), "(+", "(")
    Next
    texte = Mid(texte, 1, Len(texte) - 1) & ")"
    NbLettreToNumeric = Evaluate(texte)
.....
et on trouve bien 966569655418 comme prévu.
 

eriiic

XLDnaute Barbatruc
Bonjour à tous,

j'aurais eu une autre approche en découpant la chaine sur "mille", "million" et "milliard".
Ce qui permet de n'avoir plus que des chaines de 0 à 999 à traiter et d'ajouter facilement des puissances supérieures :
Code:
Function NbLettreToNumeric(x As String)
    Dim puissance, i As Long, ch
    puissance = Array("milliard", "million", "mille")
    '...
    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "Euros", ""), "Euro", "")
    x = Replace(x, "-", " ")
    ' insérer puissances absentes
    For i = 0 To UBound(puissance)
        x = Replace(x, puissance(i) & "s", puissance(i)) ' supp pluriels
        If InStr(x, puissance(i)) = 0 Then
            If i = 0 Then x = "|" & x Else x = Replace(x, puissance(i - 1), puissance(i - 1) & " " & puissance(i))
        End If
    Next i
    For i = 0 To UBound(puissance)
        x = Replace(x, puissance(i), "|")
    Next i
    ch = Split(x, "|")
    For i = 0 To UBound(ch)
        'traiter des nombres de 0 à 999 à formater "000"
    Next i
    ' concaténer résultat
End Function
testé sommairement, c'est juste pour le principe :)
eric
 
Dernière édition:

laurent950

XLDnaute Accro
Bonjour patrick
Evaluate
Debug.Print Evaluate(Replace(texte, " ", "") & "0)")
Les formats :

VB:
Option Explicit

Sub test()
    Dim x$

    x = "cent mille"
    MsgBox Format(NbLettreToNumeric(x), "#,##0.00")

    x = "un million"
    MsgBox Format(NbLettreToNumeric(x), "#,##0.00")

    x = "neuf cent soixante six milliards cinq cent soixante-neuf millions six cent cinquante-cinq mille quatre cent dix-huit Euros "
    MsgBox Format(NbLettreToNumeric(x), "#,##0.00")
End Sub

Function NbLettreToNumeric(x As String) As Double

    Dim Lettres, Chiffre, unitM, Multipl, i&, Segments, m&, s$, ch, c&, ind&, z#, texte$, tb

    Lettres = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", _
                    "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix", "cent", _
                    "mille", "million", "milliard", "mille", "millions", "milliards")

    Chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90, "*100", "*1000|", "*1000000|", "*1000000000|", "*1000|", "*1000000|", "*1000000000|")

    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "Euros", ""), "Euro", "")
    x = Replace(x, "-", " ")

    ch = Split(Application.Trim(x), " ")
    For c = LBound(ch) To UBound(ch)
        ind = WorksheetFunction.Match(ch(c), Lettres, 0) - 1
        s = Trim(s) & " " & Chiffre(ind) & "+"
        s = Replace(s, "+ *", "*")

        s = IIf(Left(s, 1) = "*", 1 & s, s)
    Next c
    s = s & "0"
    tb = Split(s, "|")
    For i = 0 To UBound(tb)
        texte = texte & "(" & Replace(tb(i), "*1000", ")*1000") & "+"
        texte = Replace(Replace(texte, "+ )", ")"), "(+", "(")
    Next

    'Debug.Print Replace(texte, " ", "") & "0)"
    ' -------------------------------------------------------------
    Debug.Print Evaluate(Replace(texte, " ", "") & "0)")
    Debug.Print "---------------------------------------------"
    NbLettreToNumeric = Evaluate(Replace(texte, " ", "") & "0)")
End Function

'pour tant ici ca match '
Sub test2()
    MsgBox Evaluate("(9*100+ 60+ 6)*1000000000+( 5*100+ 60+ 9)*1000000+( 6*100+ 50+ 5)*1000+( 4*100+ 10+ 8+0+0)")
End Sub
laurent
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour a tous
bon je vois que j'ai eu des réponses et je n'ai pas té averti

alors
@sylvanu oui le probleme"+0" etait bien cerné
les espaces aussi mais ca change rien erreur 2015

@eriiiic ok toi tu reviens vers le procédé de ma fonction inverse c'est a dire traiter uniquement les tranche de 3 chiffres
j'ai déjà fait une version par tranche de 3 chiffres


ce que je ne pige pas c'est que j'ai coriigé tout ces "+0" et")" mais rien n'y fait
demo debug
Capture1.JPG


et quand je teste exactement ce que j'ai dans le debug ecrit en dur dans le code ca fonctionne
VB:
Sub test2()
    MsgBox Evaluate("(9*100+60+6)*1000000000+(5*100+60+9)*1000000+(6*100+50+5)*1000+(4*100+10+8+0+0)")
End Sub

le code en entier
Code:
Option Explicit

Sub test()
    Dim x$

    x = "cent mille"
    MsgBox NbLettreToNumeric(x)

    x = "un million"
    MsgBox NbLettreToNumeric(x)

    x = "neuf cent soixante six milliards cinq cent soixante-neuf millions six cent cinquante-cinq mille quatre cent dix-huit Euros "
    MsgBox NbLettreToNumeric(x)
End Sub
Sub test2()
    MsgBox Evaluate("(9*100+60+6)*1000000000+(5*100+60+9)*1000000+(6*100+50+5)*1000+(4*100+10+8+0+0)")
End Sub

Function NbLettreToNumeric(x As String)

    Dim Lettres, Chiffre, unitM, Multipl, i&, Segments, m&, s$, ch, c&, ind&, z#, texte$, tb

    Lettres = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", _
                    "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix", "cent", _
                    "mille", "million", "milliard", "mille", "millions", "milliards")

    Chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90, "*100", "*1000|", "*1000000|", "*1000000000|", "*1000|", "*1000000|", "*1000000000|")

    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "Euros", ""), "Euro", "")
    x = Replace(x, "-", " ")

    ch = Split(Application.Trim(x), " ")
    For c = LBound(ch) To UBound(ch)
        ind = WorksheetFunction.Match(ch(c), Lettres, 0) - 1
        s = Trim(s) & " " & Chiffre(ind) & "+"
        s = Replace(s, "+ *", "*")

        s = IIf(Left(s, 1) = "*", 1 & s, s)
    Next c
    s = s & "0"
    tb = Split(s, "|")
    For i = 0 To UBound(tb)
        texte = texte & "(" & Replace(tb(i), "*1000", ")*1000") & "+"
        texte = Replace(Replace(texte, "+ )", ")"), "(+", "(")
    Next
    'NbLettreToNumeric = Evaluate(texte)

    Debug.Print Replace(texte, " ", "") & "0)"

    Debug.Print Evaluate(Replace(texte, " ", ""))
    Debug.Print "---------------------------------------------"

End Function
o_O o_O o_O o_O

j'aurais souhaité reussir cette convertion lineaire (pour le sport) et sa parfaite simplicité
même si en effet je suis limité a 999 milliards......
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
@sylvanu avec quelle version?

@eriiic
par tranche oui mais va traduire les tranches de "un million" toiavec ton split ca donne "cent |"
alors j'ai pensé a ca

VB:
Sub test()
    Dim x$

    x = "cent mille"
    MsgBox NbLettreToNumeric1(x)

    x = "un million"
    MsgBox NbLettreToNumeric1(x)

    x = "neuf cent soixante six milliards cinq cent soixante-neuf millions six cent cinquante-cinq mille quatre cent dix-huit Euros "
    MsgBox NbLettreToNumeric1(x)
End Sub

Function NbLettreToNumeric1(x As String)

    Dim Lettres, Chiffre, unitM, Multipl, i&, Segments, m&, s$, ch, c&, ind&, z#, texte$, tb

    Lettres = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf", _
                    "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix", "cent")
    tranche = Array("mille", "million", "milliard"): tranche2 = Array("|000|+|", "|000|000|+|", "|000|000|000|+|")

    Chiffre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90, "*100", "*1000|", "*1000000|", "*1000000000|", "*1000|", "*1000000|", "*1000000000|")

    x = Replace(Replace(x, " et ", " "), "d'", " ")
    x = Replace(Replace(x, "Euros", ""), "Euro", "")
    x = Replace(x, "-", " ")
    x = "0+|" & Application.Trim(x)
    For i = LBound(tranche) To UBound(tranche)
        x = Replace(Replace(x, tranche(i) & "s", tranche2(i)), tranche(i), tranche2(i))
    Next
    If Right(x, 2) = "+|" Then x = Left(x, Len(x) - 2)
  Debug.Print x
  Debug.Print "splitter  par les""|"" puis traduire uniquement ce qui est lettre puis supprimer les""|"" de la chaine en supprimantles""+|"" de la fin"
  End Function
 

patricktoulon

XLDnaute Barbatruc
re
ok laurent tu tiens le ponpon effectivement j'avais oublié de remettre le "& "0)"
juste fait de passer en debug.print /variable= j'ai bouffer ce morceaux :D :cool: :rolleyes:

des fois j'ai la tete en vrac :oops::p:cool::D:rolleyes:

on a donc tout bon
ben voila vous aviez nombre en lettre et bien maintenant vous avez nblettre en nombre
au moins jusqu'a 999 milliards .......(avec 20 lignes de code ;)
 
Dernière édition:

Discussions similaires