Résolu 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??? ;)
 
Ce fil a été résolu! Aller à la solution…

sylvanu

XLDnaute Accro
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 Accro
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 Accro
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.
 
Ce message a été identifié comme étant une solution!

eriiiic

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 Impliqué
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:

sylvanu

XLDnaute Accro
Supporter XLD
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. ;)
 

laurent950

XLDnaute Impliqué
1580032428991.png

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

resultat :
1580033860391.png
 
Ce message a été identifié comme étant une solution!
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:

patricktoulon

XLDnaute Barbatruc
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:D:D:D:D
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)
 
Dernière édition:

laurent950

XLDnaute Impliqué
Bonjour Patrick, Modeste geede, sylvanus, le forum.

Alors je suis vraiment content d'avoir pu avoir trouver cette solution c'était Pas-Triste :p :p Heureusement avec les images c'est plus clair :D:D:D ... ha ha ha Modeste geedee... je suis un débutant qui apprend vite :p:p:p

Merci à vous tous pour votre partage de toutes vos connaissances sur ce forum magique est Excel-Ent :D:D:D

Laurent
 

eriiiic

XLDnaute Barbatruc
Bonjour,

par tranche oui mais va traduire les tranches de "un million" toiavec ton split ca donne "cent |"
Effectivement, j'avais apporté une correction que je devais appliquer à 2 endroits et j'en ai oublié un.
Et comme je n'avais testé que la chaine la plus longue...
Correction :
VB:
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 = puissance(i) & 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
"cent mille" donne bien maintenant : "| |cent |"
et
"neuf cent soixante six milliards six cent cinquante-cinq mille quatre cent dix-huit Euros " donne
"neuf cent soixante six | | six cent cinquante cinq | quatre cent dix huit "
(j'ai supprimé les millions pour créer une absence)
avec milliards, millions, milles et unités à leur place

La tienne du post #12 est plus courte certes, mais retourne un peu n'importe quoi ;-)
Perso je ne suis pas un adepte du compactage à outrance, je préfère la lisibilité.
eric
 

laurent950

XLDnaute Impliqué
Comment gérer ce cas Patrick !

L'adjectif numéral « mille » est invariable : Ma tante Fernande m'a légué dix mille euros. En revanche, le nom « mille », unité de mesure internationale pour les distances en navigation aérienne et maritime, prend un « s » au pluriel : Le navire se trouve à dix milles de la côte la plus proche !
 

patricktoulon

XLDnaute Barbatruc
re
hahaha tu cherche la petite bête Laurent ;) :D

d'abords on dit MILES et non MILLES
allez je te donne un indice
on dit 10 miles,5 ou 10,5 miles

LOL
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas