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

patricktoulon · 24 Janvier 2020

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???

laurent950 · 26 Janvier 2020

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

resultat :

sylvanu · 24 Janvier 2020

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 · 24 Janvier 2020

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 · 24 Janvier 2020

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 · 25 Janvier 2020

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

laurent950 · 25 Janvier 2020

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

Fonction Format dans VBA

La fonction Format et ses variantes dans VBA.

jpcheck.developpez.com

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

patricktoulon · 26 Janvier 2020

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

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

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......

sylvanu · 26 Janvier 2020

Bonjour Patrick, le fil,
Je ne sais pas si ça peut avoir un impact mais

VB:

 'NbLettreToNumeric = Evaluate(texte)

est en commentaire.
Si vous réactivez la ligne , cela semble marcher.

patricktoulon · 26 Janvier 2020

re
@non sylvanu
les 3 tests donne une erreur "imcompatibilité de type"

laurent950 · 26 Janvier 2020

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

resultat :

sylvanu · 26 Janvier 2020

Re le fil,
Sur mon PC les trois tests passent correctement et je n'ai pas d'erreur. (XL2007)

patricktoulon · 26 Janvier 2020

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 · 26 Janvier 2020

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

des fois j'ai la tete en vrac

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

sylvanu · 26 Janvier 2020

Re,
Je suppose que ce n'est plus utile, mais comme demandé :

patricktoulon · 26 Janvier 2020

re
j'ai la même
c'est tait juste un puré de puré de puré d'oubli
et je pleure sur mon clavier depuis hier

et c'est un débutant qui me tire la barbichette
Bravo @laurent950 pour ton observation
mais @sylvanu tu n’étais pas loin toi aussi
il fallait juste que je me relise ( un peu trop sur de moi des fois)

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

patricktoulon

XLDnaute Barbatruc

laurent950

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Fonction Format dans VBA

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires