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

patricktoulon

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
laurent950
1580032428991.png


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


resultat :
1580033860391.png
Trier par date Trier par votes
sylvanu

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.
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif
eriiic

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:
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
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 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
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

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:
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
patricktoulon

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:
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
XL 2016 Problème de conversion sur VBA Excel
Réponses
1
Affichages
429
vgendron
vgendron
Usine à gaz
  • Question
Microsoft 365 conversion chiffres en lettres qui m'enlève toujours 5
2 3 4
Réponses
57
Affichages
5 K
patricktoulon
patricktoulon
G
  • Question
XL 2013 Conversion chiffres en lettre avec 3 chiffre après la virgule
Réponses
5
Affichages
3 K
patricktoulon
patricktoulon
patricktoulon
  • Résolu(e)
XL 2013 une question ou je n'arrive pas a décider
Réponses
14
Affichages
955
cp4
cp4
T
  • Question
XL 2013 veuillez m’aider à réparer la fonction spellnumber et de l'avoir en arabe aussi , je vous remercie d'avance
Réponses
1
Affichages
2 K
job75
job75
D
  • Question
Conversion de Chiffre en Lettre
2
Réponses
28
Affichages
10 K
Djoe
D
T
  • Question
Conversion de nombres écrits en chiffres vers écriture en texte
2
Réponses
21
Affichages
3 K
Toine45
T
libellule85
  • Question
Problème convertisseur de nombre en lettres pour avoir le mot euro lors de la convers
Réponses
3
Affichages
3 K
libellule85
libellule85
kdet
  • Question
Macro .xla (conversion nombre en lettre)
2
Réponses
19
Affichages
75 K
patricktoulon
patricktoulon
D
  • Question
Conversion du somme en lettre avec les centimes en chiffre!!!
Réponses
2
Affichages
12 K
Didoucha
D

Membres actuellement en ligne

2 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 783
Messages
2 112 923
Membres
111 702
dernier inscrit
ELEHMAEA