[EXCEL] Tradurre numeri in lettere

[michaltam78]

Ciao!! Visto che sono in ballo stamattina... approfitto della vostra pazienza e competenza...
Vorrei sapere se è possibile tradurre in lettere i numeri senza utilizzare codice VB
Per esempio, se in A1 inserisco il numero "30" vorrei in automatico ottenere in B1 il testo "trenta". Ovviamente inserendo "2000" in A1 in B1 ci sarà scritto "duemila" ecc. ecc.
Grazie!!

[CANAPONE]

Ciao,

uso Excel 2000 e non credo sia possibile senza l'aiuto del VB.

Spero di essere smentito da qualche amico del Forum.

[michaltam78]

Riciao!!
Ho letto da qualche parte della funzione "BAHTTESTO", che sembra realizzi proprio quello che mi serve. Ho provato ad inserire nella cella B1 =BAHTTESTO(A1) e il risultato è.... incomprensibile a dir poco. Provare per credere...

[CANAPONE]

Ciao,

se ricordo bene questa funzione (non documentata) è frutto di una scommessa/scherzo fra i programmatori di Excel.

Quello che stai vedento è la traduzione in Thai (Tailandia) delle cifre lette dalla formula.

อาศิรพจน์

(saluti)

[michaltam78]

Ahah... in Thai mi serve a ben poco...
Ho letto anche questo:

"In Microsoft Excel per Windows, è possibile modificare il formato Baht in uno stile diverso utilizzando il comando Opzioni internazionali nel Pannello di controllo."

Credi sia possibile davvero?? Sembra inoltre che la funzione oltre a "tradurre" il numero in lettere aggiunga anche il suffisso "baht"....

[CANAPONE]

Ciao,

non credo sia possibile.

Per tua curiosità prova a copiare sul traduttore di Google le stringhe che ottieni.

สองพันบาทถ้วน

è effettivamente 2000.

Credo sia meglio sfruttare il VB: in rete non credo sia difficile trovare una UDF (funzione dedicata) che ti aiuti.

Saluti

[michaltam78]

In effetti in rete non si trova nulla in merito. Penso che dovrò rassegnarmi al _VB oppure al caro vecchio stile "manuale"
Grazie e ciao!!

[wallace&gromit]

Probabilmente la lingua Baht è più furba dell'italiano (e di parecchie altre lingue comunque) e rende possibile una lettura delle cifre pezzo per pezzo.
Per quanto ci riguarda, con le formule di excel penso che si arriverebbe facilmente ad un risultato tipo 2012 = duemiladiecidue e 2023 = duemiladuediecitre!!!

[michaltam78]

Forte... ma poco chiaro direi :-)

[michaltam78]

Ho trovato un modo per farlo!! Si tratta di un addin trovato in giro per la rete!

[Flash30005]

Non ho capito se era solo una curiosità o necessità
Una macro può divenire funzione quindi "formula"
Se occorre potrei pubblicare la macro.

Ho trovato un modo per farlo!! Si tratta di un addin trovato in giro per la rete!

Di quale Addin si tratta? potresti pubblicarlo?

ciao

[michaltam78]

Ciao Flash!! Diciamo una via di mezzo tra curiosità e necessità. Nel senso che se non fossi riuscito a farlo il documento sarebbe comq andato bene.
L'addin l'ho trovato curiosando in rete, su un altro forum a cui però non sono iscritto. Ho trovato il link per scaricare l'addin. Posso pubblicare quello, si può fare?

[Flash30005]

La macro che ho realizzato converte
da 0 (zero)
a 999.999.999.999.990.000
(Novecentonovantanovetriliardinovecentonovantanovetrilioninovecentonovantanovemiliardinovecentonovantanovemilioninovecentonovanta)

Ciao

[michaltam78]

Mai visto un numero simile... penso che sia sufficiente!! :-)
L'altra soluzione che ti propongo arriva a 999.999.999.999
(novecentonovantanovemiliardinovecentonovantanovemilioninovecentonovantanove).

[Flash30005]

Beh visto che ho fatto il lavoro lo pubblico per gli interessati
in un modulo va inserita questa macro

Codice: Seleziona tutto

Sub ConvertiNumInLettere()
Num = [A1]
LNum = Len(Num)
Dim VN(105) As String
Dim VP(5) As String
VN(0) = "zero"
VN(1) = "uno"
VN(2) = "due"
VN(3) = "tre"
VN(4) = "quattro"
VN(5) = "cinque"
VN(6) = "sei"
VN(7) = "sette"
VN(8) = "otto"
VN(9) = "nove"
VN(10) = "dieci"
VN(11) = "undici"
VN(12) = "dodici"
VN(13) = "tredici"
VN(14) = "quattordici"
VN(15) = "quindici"
VN(16) = "sedici"
VN(17) = "diciassette"
VN(18) = "diciotto"
VN(19) = "diciannove"
VN(20) = "venti"
VN(30) = "trenta"
VN(40) = "quaranta"
VN(50) = "cinquanta"
VN(60) = "sessanta"
VN(70) = "settanta"
VN(80) = "ottanta"
VN(90) = "novanta"
VN(100) = "cento"

VP(1) = "mila"
If Len(Format(Num, "#,##0")) = 5 And Left(Num, 1) = 1 Then VP(1) = "mille"
VP(2) = "milioni"
If Len(Format(Num, "#,##0")) = 9 And Left(Num, 1) = 1 Then VP(2) = "milione"
VP(3) = "miliardi"
If Len(Format(Num, "#,##0")) = 13 And Left(Num, 1) = 1 Then VP(3) = "miliardo"
VP(4) = "trilioni"
If Len(Format(Num, "#,##0")) = 17 And Left(Num, 1) = 1 Then VP(4) = "trilione"
VP(5) = "triliardi"
If Len(Format(Num, "#,##0")) = 21 And Left(Num, 1) = 1 Then VP(5) = "triliardo"

NFin = ""


LLN = Len(Format(Num, "#,##0"))
CP = 0
For Col = 1 To LLN
If Mid(Format(Num, "#,##0"), Col, 1) = "." Then CP = CP + 1
Next Col
Col = 1
AggM = ""
PEcc = 0
If CP > 5 Then
MsgBox "Attenzione superato limite numerico", vbExclamation
Exit Sub
End If
For ColN = 1 To LLN

AggM = VP(CP)
CP = CP - 1
If CP < 0 Then CP = 0
Col = ColN
Campo = ""
Call RiempiCampo
If PEcc = 0 Then
If Len(Format(Num, "#,##0")) = 9 Or Len(Format(Num, "#,##0")) = 13 Or Len(Format(Num, "#,##0")) = 17 Or Len(Format(Num, "#,##0")) = 21 Then VN(1) = "un"
If Len(Format(Num, "#,##0")) = 5 Then VN(1) = ""
PEcc = 1
Else
VN(1) = "uno"
End If
LNum = Len(Campo)
ColN = Col


Ini:
Select Case LNum
Case 3
    NumC = Mid(Campo, Len(Campo) - 2, 1)
    If NumC <> 1 Then
        NFin = NFin & VN(NumC) & VN(100)
    Else
        NFin = NFin & VN(100)
    End If
    LNum = 2
    GoTo Ini:
Case 2
    NumD = Right(Campo, 2)
    If NumD > 20 Then
        NFin = NFin & VN(Val(Left(NumD, 1) * 10))
        If Right(NumD, 1) = 1 Then NFin = Left(NFin, Len(NFin) - 1)
        If Right(NumD, 1) <> 0 Then
            LNum = 1
            GoTo Ini:
        End If
    Else
        If NumD <> 0 Then NFin = NFin & VN(NumD) & AggM
    End If
Case 1
    NumU = Right(Campo, 1)
    If NumU = 0 Then
    NFin = NFin & AggM
    If NFin = "" Then NFin = VN(NumU)
    Else
    NFin = NFin & VN(NumU) & AggM
    End If
End Select
SaltaC:
Next ColN
[B1] = StrConv(NFin, vbProperCase)

End Sub

Sub RiempiCampo()
Do Until Mid(Format(Num, "#,##0"), Col, 1) = "."
Campo = Campo & Mid(Format(Num, "#,##0"), Col, 1)
Col = Col + 1
If Col > LLN Then Exit Do
Loop
Campo = Val(Campo)
End Sub


Mentre se si vuole automatizzare (per avere il risultato in B1)
ad ogni variazione della cifra in A1 bisogna inserire questo codice nel Vba del foglio

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then Call ConvertiNumInLettere
End Sub


Ho testato a lungo il programma
ma potrebbe verifcarsi qualche bug che vi chiedo cortesemente di far presente.

ciao

[wallace&gromit]

ciao Flash,
non riesco a fare funzionare la tua macro.
Non è precisamente la cosa a cui non posso fare a meno ma mi incuriosisce.
Potresti allegare un file funzionante?

[Flash30005]

Nella copia macro è sfuggita la dichiarazione public di alcune variabili necessarie

Codice: Seleziona tutto

Public Col, LLN As Integer, Campo, NFin As String, Num As Double

Comunque Ecco il file

ciao

[wallace&gromit]

adesso funziona, c'è solo ancora un caso non risolto quando il finale è 8: scrive per esempio ventiotto invece di ventotto.

[Flash30005]

Senza dover creare eccezioni all'interno della macro penso che la cosa più semplice da fare sia una riga di codice alla fine

Codice: Seleziona tutto

Next ColN
NFin = Replace(Replace(NFin, "tiotto", "totto"), "taotto", "totto") '<<<< aggiunta
[B1] = StrConv(NFin, vbProperCase)
End Sub

ciao

[Anthony47]

Contribuisco con la "funzione" SpellIt; partendo da un numero si puo' ottenere il suo spelling con la formula

Codice: Seleziona tutto

=SpellIt(IlNumero;iDecimali)

La parte iDecimali e' opzionale, di default si usa "2"; i numeri negativi vengono precedti dal segno "meno".
Per mia comodita' avevo separato le "migliaia" con il "punto"; ad esempio ventottomila.ottocentoottantotto/20; nel listing e' ben evidente dove modificare se si preferisce il meno comprensibile ventottomilaottocentoottantotto/20.
Max capacita', per scelta, impostata a +/- 2.147.483.647; chi ha esigenze superiori puo' pagare un programmatore per eliminare questo limite
Il codice va messo in un Modulo standard, facendo in modo che la Option Base sia in testa a tutto:

Codice: Seleziona tutto

Option Base 1
Dim sSpell As String
Function SpellIt(ByVal myValore As Double, Optional ByVal myDec As Integer = 2) As String
'traduce un valore nel suo spelling, by Anthony47
'
'Uso:
'      =SPELLIT(ValoreNumerico [;NumDecimali])
'               NumDecimali e' opzionale, di default viene usato 2
'
'Esempio
'=SPELLIT(456,789) restituira' "quattrocentocinquantasei/79"
'
'Max ValNumerico = 2.147.483.647
'I Negativi vengono rappresentati come "-(Spelling)"
'
Dim sValore As String, sPotenza, uPotenza, I As Long, myMille As String, vValore As Long
'
sSpell = ""
'Valori chiave e sostituzioni
sPotenza = Array("miliardi.", "milioni.", "mila.", "")
uPotenza = Array("unmiliardo.", "unmilione.", "mille.", "")
'
sValore = Format(Abs(Fix(myValore)), "000000000000")
vValore = Int(Abs(myValore))
'
For I = 1 To 4   '4 blocchi "migliaia"
myMille = Mid(sValore, 1 + (I - 1) * 3, 3)
If CLng(myMille) > 0 Then
    If CLng(myMille) = 1 Then
        sSpell = sSpell & uPotenza(I)
    Else
        sSpell = sSpell & sMille(myMille) & sPotenza(I)
    End If
End If
Next I
'Compila spelling
If sSpell = "" Then sSpell = "zero"
If myDec > 0 Then myVirg = "/" & Round((Abs(myValore) - vValore) * (10 ^ myDec), 0)
SpellIt = sSpell & myVirg
If myValore < 0 Then SpellIt = "-(" & SpellIt & ")"
End Function

Function sMille(ByVal sBlocco As String) As String
Dim vNum, sNum, vBlocco As Long, nwBlocco As String, strNum As String
Dim Iv As Long
'
'Valori chiave
vNum = 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)
sNum = Array("", "uno", "due", "tre", "quattro", "cinque", "sei", "sette", "otto", "nove", "dieci", "undici", _
    "dodici", "tredici", "quattordici", "quindici", "sedici", "diciassette", "diciotto", "diciannove", "venti", _
    "trenta", "quaranta", "cinquanta", "sessanta", "settanta", "ottanta", "novanta", "cento")
If Len(sBlocco) > 3 Then   'Sara' sempre Falso
    sMille = "#####": Exit Function
End If
'
strNum = sBlocco
ReBlk:
vBlocco = CLng(strNum)
If vBlocco > 99 Then
    nwBlocco = Left(strNum, 1)
    If vBlocco > 199 Then
        txt1 = sMille(nwBlocco) & "cento"
        strNum = Replace(strNum, nwBlocco, "", 1, 1)
    Else
        txt1 = "cento"
        strNum = Replace(strNum, nwBlocco, "", 1, 1)
    End If
End If
If vBlocco > 199 Then GoTo ReBlk
If vBlocco <= 20 Then GoTo Fase3
Fase2:
vBlocco = CLng(strNum)
    CPart = Application.Match(vBlocco, vNum)
    txt2 = sNum(CPart)
    CVal = vNum(CPart)
    vBlocco = vBlocco - CVal
Fase3:
If vBlocco > 0 Then
    txt3 = sNum(vBlocco + 1)
'    txt3 = sMille(Format(vBlocco, "0"))
End If
'
'Compila spelling
If (Left(txt3, 1) = "u" Or Left(txt3, 1) = "o") And Len(txt2) > 0 Then _
    txt2 = Left(txt2, Len(txt2) - 1)
sMille = txt1 & txt2 & txt3
End Function


Ciao a tutti.

EDIT: Vedere Versione2 con correzioni a pag 2