Precedente :: Successivo |
Autore |
Messaggio |
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 05 Ott 2008 19:05 Oggetto: Excel: Ricavare numero in lettere da quello in cifre |
|
|
Ho elaborato delle bollette condominiali con conteggi di spese diverse però mi occorre che il totale in numeri mi venga scritto in automatico anche in lettere, è possibile una cosa del genere ?
A chi mi aiuta un grazie .... |
|
Top |
|
|
chemicalbit Dio maturo
Registrato: 01/04/05 17:59 Messaggi: 18597 Residenza: Milano
|
Inviato: 05 Ott 2008 22:08 Oggetto: |
|
|
Quindi hai bisogno che Excel ti ricavi il numero in lettere a partire da quello in cifre, giusto?
Modifico il titolo della discussione, in modo che ciò sia chiaro ed evidente,
così sarà più facile che qualcuno provi ad aiutarti. |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 07 Ott 2008 20:20 Oggetto: |
|
|
nero.bm ha scritto: | Ho elaborato delle bollette condominiali con conteggi di spese diverse però mi occorre che il totale in numeri mi venga scritto in automatico anche in lettere, è possibile una cosa del genere ? |
Ceerrrrrto!! con una macro e una funzione:
macro
Codice: |
Sub Trasforma()
Dim oWB As Workbook
Dim oWS As Worksheet
Dim sText As String
Dim sNum As String
Set oWB = ThisWorkbook
Set oWS = oWB.ActiveSheet
With oWS
'-------------------------------------------
sNum = .Range("A1").Text
sText = sCifraInLettere(sNum)
.Range("B1") = sText
'-------------------------------------------
sNum = .Range("A2").Text
sText = sCifraInLettere(sNum)
.Range("B2") = sText
'-------------------------------------------
sNum = .Range("A3").Text
sText = sCifraInLettere(sNum)
.Range("B3") = sText
'-------------------------------------------
sNum = .Range("A4").Text
sText = sCifraInLettere(sNum)
.Range("B4") = sText
'-------------------------------------------
sNum = .Range("A5").Text
sText = sCifraInLettere(sNum)
.Range("B5") = sText
'-------------------------------------------
sNum = .Range("A6").Text
sText = sCifraInLettere(sNum)
.Range("B6") = sText
'-------------------------------------------
sNum = .Range("A7").Text
sText = sCifraInLettere(sNum)
.Range("B7") = sText
'-------------------------------------------
sNum = .Range("A8").Text
sText = sCifraInLettere(sNum)
.Range("B8") = sText
'-------------------------------------------
End With
End Sub
|
funzione
Codice: |
Function sCifraInLettere(CifraInNumero As String) As String
Dim CifraInCaratteri, StringaInCostruzione, PrimoCharMaiusc As String
Dim aUnita, aDecine, aCentin, aSottoVenti, a, b As Variant
Dim nUn, nDec, nCent, nMigl, nCentMigl As Integer
Dim nMilion, nDecMilion, nCentMilion As Integer
'Assegamenti alle matrici: siccome la numerazione degli elementi in VB
'inizia da 0 mettiamo al primo posto una stringa vuota in modo
'che il primo elemento che conta sia all'indice 1 dell'array
'per non creare confusione dopo.
aUnita = Array("", "un", "due", "tre", "quattro", "cinque", _
"sei", "sette", "otto", "nove")
aDecine = Array("", "dieci", "venti", "trenta", "quaranta", _
"cinquanta", "sessanta", "settanta", _
"ottanta", "novanta")
aCentin = Array("", "cento", "duecento", "trecento", _
"quattrocento", "cinquecento", "seicento", _
"settecento", "ottocento", "novecento")
aSottoVenti = Array("", "dieci", "undici", "dodici", _
"tredici", "quattordici", _
"quindici", "sedici", "diciasette", _
"diciotto", "diciannove")
'Il codice seguente conserva la lunghezza della stringa a 9 caratteri
CifraInCaratteri = Trim(Str$(CifraInNumero))
If (Len(CifraInCaratteri) = 1) Then
CifraInCaratteri = "00000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 2) Then
CifraInCaratteri = "0000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 3) Then
CifraInCaratteri = "000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 4) Then
CifraInCaratteri = "00000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 5) Then
CifraInCaratteri = "0000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 6) Then
CifraInCaratteri = "000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 7) Then
CifraInCaratteri = "00" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 8) Then
CifraInCaratteri = "0" & CifraInCaratteri
End If
nUn = Val(Mid$(CifraInCaratteri, 9, 1))
nDec = Val(Mid$(CifraInCaratteri, 8, 1))
nCent = Val(Mid$(CifraInCaratteri, 7, 1))
nMigl = Val(Mid$(CifraInCaratteri, 6, 1))
nDecMigl = Val(Mid$(CifraInCaratteri, 5, 1))
nCentMigl = Val(Mid$(CifraInCaratteri, 4, 1))
nMilion = Val(Mid$(CifraInCaratteri, 3, 1))
nDecMilion = Val(Mid$(CifraInCaratteri, 2, 1))
nCentMilion = Val(Mid$(CifraInCaratteri, 1, 1))
If (nCentMilion <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMilion)
End If
If (nDecMilion <> 0) Then
If (nDecMilion < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMilion + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMilion)
End If
End If
If (nMilion <> 0 And nDecMilion <> 1) Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMilion)
End If
If (nCentMilion = 0 And nDecMilion = 0 And nMilion = 1) Then
StringaInCostruzione = StringaInCostruzione & "milione"
End If
If (nCentMilion <> 0 Or nDecMilion <> 0 Or nMilion > 1) Then
StringaInCostruzione = StringaInCostruzione & "milioni"
End If
If (nCentMigl <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMigl)
End If
If (nDecMigl <> 0) Then
If (nDecMigl < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMigl + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMigl)
End If
End If
If (nMigl <> 0 And nDecMigl <> 1) Then
If (Not (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1)) _
Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMigl)
End If
End If
If (nCentMigl <> 0 Or nDecMigl <> 0 Or nMigl <> 0) Then
If (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1) _
Then
StringaInCostruzione = StringaInCostruzione & "mille"
Else
StringaInCostruzione = StringaInCostruzione & "mila"
End If
End If
If (nCent <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCent)
End If
If (nDec <> 0) Then
If (nDec < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nUn + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDec)
End If
End If
If (nUn <> 0 And nDec <> 1) Then
If (nUn = 1) Then
StringaInCostruzione = StringaInCostruzione & "uno"
Else
StringaInCostruzione = StringaInCostruzione & aUnita(nUn)
End If
End If
StringaInCostruzione = StrConv(StringaInCostruzione, vbProperCase)
sCifraInLettere = StringaInCostruzione
End Function
|
Premetto che la funzione non è farina del mio sacco
l'ho reperita tempo fa nel web ed era scritta per visual basic,
io l'ho solo adattata per farla funzionare in vba [ben poco lavoro in ogni caso]
come funziona
Citazione: |
Per il foglio attivo
rileva il valore numerico di una cella alla volta [nell'esempio le celle da A1 a A8]
utilizza il contenuto come parametro della funzione di transcodifica
pone il risultato nelle corrispondenti celle della colonna B
ATTENZIONE:
se si indica una cella che NON contiene un valore numerico sarà restituito un errore di "tipo non corrispondente"
|
come operare
Citazione: |
- da menu : creare una macro con:
Strumenti ->Macro ->Macro -> Crea
fornire il nome [nell'esempio l'ho chiamata Trasforma]
- appare la finestra di progettazione vba
Copiare/incollare il contenuto compreso fra le righe Sub Trasforma() e End Sub [escluse perché la creazione della macro le ha già definite]
- dopo la riga contenente End sub copiare/incollare TUTTO il codice della funzione, [nome compreso]
- Fatto!
- per provare il funzionamento inserire nelle celle da A1 ad A8 del Foglio1 [ma vale per qualsiasi foglio] i seguenti valori:
1
21
312
4123
51234
612345
7123456
81234567
[la macro tratta queste otto celle, a voi l'onere di indicare quelle corrette]
- eseguire la macro
- verificato il funzionamento modificare la macro inserendo le coordinate corrette della/e cella/e che contiene(tengono) il valore da transcodificare e le coordinate della cella/e che conterrà(nno) la stringa letterale
- eliminare riferimenti e richiamo di ciò che non serve
|
Edit
Un esempio [un po' più lungo] ma che funziona anche con i centesimi di euro lo si può trovare qui |
|
Top |
|
|
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 09 Ott 2008 11:38 Oggetto: |
|
|
chiedo troppo se mi dai le indicazioni per la trasformazione del numero anche con i decimali ? ho provato con l'esempio ma non ci sono riuscito!!!
comunque sei un grande!!! |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 09 Ott 2008 12:47 Oggetto: |
|
|
nero.bm ha scritto: | chiedo troppo se mi dai le indicazioni per la trasformazione del numero anche con i decimali ? ho provato con l'esempio ma non ci sono riuscito!!!
|
No, non chiedi troppo...
devo lavorarci un po'...
Le domande sono:
- la transcodifica letterale dei centesimi deve essere come negli assegni? [cioè, a esempio: cento/37 dove 37 naturalmente sono i centesimi]
- come esprimi il numero con i centesimi? [con la notazione italiana, a esempio: 100,37]
|
|
Top |
|
|
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 09 Ott 2008 13:41 Oggetto: |
|
|
1) E' come per gli assegni es.:
112,50 = centododici/50
2) la cifra è 326,30 notazione italiana
Inoltre ho notato che nella conversione del numero 21 mi viene riportato
ventiuno non è possibile far scrivere ventuno.
Buon lavoro!!!!
|
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 09 Ott 2008 22:11 Oggetto: |
|
|
Ecco qua, la nuova versione
Modifiche apportate
Citazione: |
- troncata l'ultima lettera della decina quando seguita da 1
- inserito il controllo di numericità
[se la cella contiene un valore non numerico è prodotto un messaggio]
- filtrato il valore, eliminando gli eventuali punti di separazione delle migliaia
- aggiunto il valore numerico dei decimali, separato da una barra, alla transcodifica letterale
|
Codice: |
Function sCifraInLettere(CifraInNumero As Variant) As String
Dim CifraInCaratteri, StringaInCostruzione, PrimoCharMaiusc As String
Dim aUnita, aDecine, aCentin, aSottoVenti, a, b As Variant
Dim nUn, nDec, nCent, nMigl, nCentMigl As Integer
Dim nMilion, nDecMilion, nCentMilion As Integer
Dim sDecimali As String
Dim avTmp As Variant
If InStr(CifraInNumero, ",") > 0 Then
avTmp = Split(CifraInNumero, ",")
CifraInNumero = avTmp(0)
If Len(avTmp(1)) = 1 Then
sDecimali = avTmp(1) & "0"
Else
sDecimali = avTmp(1)
End If
End If
CifraInNumero = Replace(CifraInNumero, ".", "")
If Not IsNumeric(CifraInNumero) Then
MsgBox "la cella non contiene un valore numerico"
Exit Function
End If
'Assegamenti alle matrici: siccome la numerazione degli elementi in VB
'inizia da 0 mettiamo al primo posto una stringa vuota in modo
'che il primo elemento che conta sia all'indice 1 dell'array
'per non creare confusione dopo.
aUnita = Array("", "un", "due", "tre", "quattro", "cinque", _
"sei", "sette", "otto", "nove")
aDecine = Array("", "dieci", "venti", "trenta", "quaranta", _
"cinquanta", "sessanta", "settanta", _
"ottanta", "novanta")
aCentin = Array("", "cento", "duecento", "trecento", _
"quattrocento", "cinquecento", "seicento", _
"settecento", "ottocento", "novecento")
aSottoVenti = Array("", "dieci", "undici", "dodici", _
"tredici", "quattordici", _
"quindici", "sedici", "diciasette", _
"diciotto", "diciannove")
'Il codice seguente conserva la lunghezza della stringa a 9 caratteri
CifraInCaratteri = Trim(Str$(CifraInNumero))
If (Len(CifraInCaratteri) = 1) Then
CifraInCaratteri = "00000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 2) Then
CifraInCaratteri = "0000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 3) Then
CifraInCaratteri = "000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 4) Then
CifraInCaratteri = "00000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 5) Then
CifraInCaratteri = "0000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 6) Then
CifraInCaratteri = "000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 7) Then
CifraInCaratteri = "00" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 8) Then
CifraInCaratteri = "0" & CifraInCaratteri
End If
nUn = Val(Mid$(CifraInCaratteri, 9, 1))
nDec = Val(Mid$(CifraInCaratteri, 8, 1))
nCent = Val(Mid$(CifraInCaratteri, 7, 1))
nMigl = Val(Mid$(CifraInCaratteri, 6, 1))
nDecMigl = Val(Mid$(CifraInCaratteri, 5, 1))
nCentMigl = Val(Mid$(CifraInCaratteri, 4, 1))
nMilion = Val(Mid$(CifraInCaratteri, 3, 1))
nDecMilion = Val(Mid$(CifraInCaratteri, 2, 1))
nCentMilion = Val(Mid$(CifraInCaratteri, 1, 1))
If (nCentMilion <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMilion)
End If
If (nDecMilion <> 0) Then
If (nDecMilion < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMilion + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMilion)
End If
End If
If (nMilion <> 0 And nDecMilion <> 1) Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMilion)
End If
If (nCentMilion = 0 And nDecMilion = 0 And nMilion = 1) Then
StringaInCostruzione = StringaInCostruzione & "milione"
End If
If (nCentMilion <> 0 Or nDecMilion <> 0 Or nMilion > 1) Then
StringaInCostruzione = StringaInCostruzione & "milioni"
End If
If (nCentMigl <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMigl)
End If
If (nDecMigl <> 0) Then
If (nDecMigl < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMigl + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMigl)
End If
End If
If (nMigl <> 0 And nDecMigl <> 1) Then
If (Not (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1)) _
Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMigl)
End If
End If
If (nCentMigl <> 0 Or nDecMigl <> 0 Or nMigl <> 0) Then
If (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1) _
Then
StringaInCostruzione = StringaInCostruzione & "mille"
Else
StringaInCostruzione = StringaInCostruzione & "mila"
End If
End If
If (nCent <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCent)
End If
If (nDec <> 0) Then
If (nDec < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nUn + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDec)
If CifraInCaratteri Mod 10 = 1 Then
StringaInCostruzione = Left(StringaInCostruzione, Len(StringaInCostruzione) - 1)
End If
End If
End If
If (nUn <> 0 And nDec <> 1) Then
If (nUn = 1) Then
StringaInCostruzione = StringaInCostruzione & "uno"
Else
StringaInCostruzione = StringaInCostruzione & aUnita(nUn)
End If
End If
StringaInCostruzione = StrConv(StringaInCostruzione, vbProperCase)
If Len(sDecimali) > 0 Then
StringaInCostruzione = StringaInCostruzione & "/" & sDecimali
'* commentare [con un APICE SINGOLO A INIZIO RIGA]
'* le due righe sottostanti se NON si vuole l'aggiunta di /00
'* QUANDO NON CI SONO DECIMALI
Else
StringaInCostruzione = StringaInCostruzione & "/00"
End If
sCifraInLettere = StringaInCostruzione
End Function
|
note di particolare interesse
Citazione: |
- se NON si vuole che, alla transcodifica delle cifre intere sia aggiunta la costante /00, come descritto nel codice, commentare le due righe indicate; quindi con:
Citazione: | ' Else
' StringaInCostruzione = StringaInCostruzione & "/00"
|
la costante /00 NON sarà aggiunta alla stringa letterale
- se si vuole evitare di scrivere la macro [Trasforma nell'esempio] è possibile inserire nelle celle il richiamo diretto alla funzione, nella forma:
Citazione: | =sCifraInLettere(coordinate_della_cella) |
a esempio se in B1 si scrive: =sCifraInLettere(A1) e il valore di A1 è numerico, all'invio, in B1 si otterrà la transcodifica letterale
|
L'ultima modifica di GrayWolf il 10 Ott 2008 20:16, modificato 2 volte |
|
Top |
|
|
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 10 Ott 2008 16:11 Oggetto: |
|
|
E' tutto ok unico neo:
se scrivo 24,40 la traformazione mi da ventiquattro/4
che modifica devo fare per avere ventiquattro/40
Debitore per la vostra disponibilità!!!!! |
|
Top |
|
|
chemicalbit Dio maturo
Registrato: 01/04/05 17:59 Messaggi: 18597 Residenza: Milano
|
Inviato: 10 Ott 2008 17:06 Oggetto: |
|
|
nero.bm ha scritto: | se scrivo 24,40 la traformazione mi da ventiquattro/4
che modifica devo fare per avere ventiquattro/40 | Ti capita solo in quel caso,
oppure in qualuqnue caso in cui il secondo decimale sia 0? |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 10 Ott 2008 19:37 Oggetto: |
|
|
modifica la chiamata di funzione
da:
Citazione: | Function sCifraInLettere(CifraInNumero As String) As String
|
in:
Citazione: | Function sCifraInLettere(CifraInNumero As Variant) As String |
e l'istruzione:
da:
Citazione: | sDecimali = avTmp(1) |
in:
Citazione: | sDecimali = Right(Format(avTmp(1) * 0.1, "###########0.00"), 2)
|
dove:
precedente
dopo la modifica
NOTA: ho modificato lo script con le correzioni
L'ultima modifica di GrayWolf il 10 Ott 2008 19:57, modificato 1 volta |
|
Top |
|
|
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 10 Ott 2008 19:57 Oggetto: |
|
|
Con la macro funziona, ma con il richiamo diretto della funzione nella forma =sCifraInLettere(coordinate_della _cella) no ancora. |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 10 Ott 2008 19:59 Oggetto: |
|
|
strano...
hai apportato tutte e due le modifiche?
la seconda l'ho aggiunta forse mentre stavi leggendo... |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 10 Ott 2008 20:21 Oggetto: |
|
|
hai ragione... quando deve decodificare una sommatoria fa casino
per tagliare la testa al toro [povero toro]
fai quest'altra modifica
l'istruzione:
da:
Citazione: | sDecimali = Right(Format(avTmp(1) * 0.1, "###########0.00"), 2) |
in:
Citazione: | If Len(avTmp(1)) = 1 Then
sDecimali = avTmp(1) & "0"
Else
sDecimali = avTmp(1)
End If
|
dove:
precedente [dopo la prima modifica]
dopo la modifica
NOTA: ho modificato lo script con le correzioni |
|
Top |
|
|
ro76 Comune mortale
Registrato: 18/10/08 09:28 Messaggi: 2
|
Inviato: 18 Ott 2008 09:47 Oggetto: |
|
|
Ciao GrayWolf,
questa macro è proprio quello che cercavo. Ti ringrazio di averla resa disponibile.
C'è però un piccolo problema. Quando i numeri sono 28, 38, 48, 58, 68, 78, 88, 98 la conversione li trasforma in "ventiotto", "trentaotto", "quarantaotto" ecc.
Dovrebbe essere, invece, "ventotto", "trentotto", "quarantotto" ecc.
Insomma quando l'ultimo numero è otto andrebbe fatta la stessa conversione che si fa quando l'ultimo numero è uno.
Visto che io capisco poco di programmazione e non capisco dove dovrei modificare, saresti così gentile da apportare questa ulteriore modifica al codice?
Grazie! |
|
Top |
|
|
nero.bm Eroe in grazia degli dei
Registrato: 02/10/08 15:51 Messaggi: 105
|
Inviato: 18 Ott 2008 19:20 Oggetto: |
|
|
Ti scrivo la macro completa che fino ad ora non mi ha dato problemi, ma ..... non è farina del mio sacco (ho fatto una lieve modifica):
-------------------------------------------------------------------------------------
Sub trasforma()
Dim oWB As Workbook
Dim oWS As Worksheet
Dim sText As String
Dim sNum As String
Set oWB = ThisWorkbook
Set oWS = oWB.ActiveSheet
With oWS
'-------------------------------------------
' sNum = .Range("H23").Text
' sText = sCifraInLettere(sNum)
' .Range("C8") = sText
'-------------------------------------------
' sNum = .Range("A2").Text
' sText = sCifraInLettere(sNum)
' .Range("B2") = sText
'-------------------------------------------
' sNum = .Range("A3").Text
' sText = sCifraInLettere(sNum)
' .Range("B3") = sText
'-------------------------------------------
' sNum = .Range("A4").Text
' sText = sCifraInLettere(sNum)
' .Range("B4") = sText
'-------------------------------------------
' sNum = .Range("A5").Text
' sText = sCifraInLettere(sNum)
' .Range("B5") = sText
'-------------------------------------------
' sNum = .Range("A6").Text
' sText = sCifraInLettere(sNum)
' .Range("B6") = sText
'-------------------------------------------
' sNum = .Range("A7").Text
' sText = sCifraInLettere(sNum)
' .Range("B7") = sText
'-------------------------------------------
' sNum = .Range("A8").Text
' sText = sCifraInLettere(sNum)
' .Range("B8") = sText
'-------------------------------------------
End With
End Sub
Function sCifraInLettere(CifraInNumero As Variant) As String
Dim CifraInCaratteri, StringaInCostruzione, PrimoCharMaiusc As String
Dim aUnita, aDecine, aCentin, aSottoVenti, a, b As Variant
Dim nUn, nDec, nCent, nMigl, nCentMigl As Integer
Dim nMilion, nDecMilion, nCentMilion As Integer
Dim sDecimali As String
Dim avTmp As Variant
If InStr(CifraInNumero, ",") > 0 Then
avTmp = Split(CifraInNumero, ",")
CifraInNumero = avTmp(0)
If Len(avTmp(1)) = 1 Then
SDecimali =avTmp(1) & ?0?
Else
sDecimali = avTmp(1)
End If
End If
CifraInNumero = Replace(CifraInNumero, ".", "")
If Not IsNumeric(CifraInNumero) Then
MsgBox "la cella non contiene un valore numerico"
Exit Function
End If
'Assegamenti alle matrici: siccome la numerazione degli elementi in VB
'inizia da 0 mettiamo al primo posto una stringa vuota in modo
'che il primo elemento che conta sia all'indice 1 dell'array
'per non creare confusione dopo.
aUnita = Array("", "un", "due", "tre", "quattro", "cinque", _
"sei", "sette", "otto", "nove")
aDecine = Array("", "dieci", "venti", "trenta", "quaranta", _
"cinquanta", "sessanta", "settanta", _
"ottanta", "novanta")
aCentin = Array("", "cento", "duecento", "trecento", _
"quattrocento", "cinquecento", "seicento", _
"settecento", "ottocento", "novecento")
aSottoVenti = Array("", "dieci", "undici", "dodici", _
"tredici", "quattordici", _
"quindici", "sedici", "diciasette", _
"diciotto", "diciannove")
'Il codice seguente conserva la lunghezza della stringa a 9 caratteri
CifraInCaratteri = Trim(Str$(CifraInNumero))
If (Len(CifraInCaratteri) = 1) Then
CifraInCaratteri = "00000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 2) Then
CifraInCaratteri = "0000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 3) Then
CifraInCaratteri = "000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 4) Then
CifraInCaratteri = "00000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 5) Then
CifraInCaratteri = "0000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 6) Then
CifraInCaratteri = "000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 7) Then
CifraInCaratteri = "00" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 8) Then
CifraInCaratteri = "0" & CifraInCaratteri
End If
nUn = Val(Mid$(CifraInCaratteri, 9, 1))
nDec = Val(Mid$(CifraInCaratteri, 8, 1))
nCent = Val(Mid$(CifraInCaratteri, 7, 1))
nMigl = Val(Mid$(CifraInCaratteri, 6, 1))
nDecMigl = Val(Mid$(CifraInCaratteri, 5, 1))
nCentMigl = Val(Mid$(CifraInCaratteri, 4, 1))
nMilion = Val(Mid$(CifraInCaratteri, 3, 1))
nDecMilion = Val(Mid$(CifraInCaratteri, 2, 1))
nCentMilion = Val(Mid$(CifraInCaratteri, 1, 1))
If (nCentMilion <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMilion)
End If
If (nDecMilion <> 0) Then
If (nDecMilion < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMilion + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMilion)
End If
End If
If (nMilion <> 0 And nDecMilion <> 1) Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMilion)
End If
If (nCentMilion = 0 And nDecMilion = 0 And nMilion = 1) Then
StringaInCostruzione = StringaInCostruzione & "milione"
End If
If (nCentMilion <> 0 Or nDecMilion <> 0 Or nMilion > 1) Then
StringaInCostruzione = StringaInCostruzione & "milioni"
End If
If (nCentMigl <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMigl)
End If
If (nDecMigl <> 0) Then
If (nDecMigl < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMigl + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMigl)
End If
End If
If (nMigl <> 0 And nDecMigl <> 1) Then
If (Not (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1)) _
Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMigl)
End If
End If
If (nCentMigl <> 0 Or nDecMigl <> 0 Or nMigl <> 0) Then
If (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1) _
Then
StringaInCostruzione = StringaInCostruzione & "mille"
Else
StringaInCostruzione = StringaInCostruzione & "mila"
End If
End If
If (nCent <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCent)
End If
If (nDec <> 0) Then
If (nDec < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nUn + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDec)
If CifraInCaratteri Mod 10 = 1 Then
StringaInCostruzione = Left(StringaInCostruzione, Len(StringaInCostruzione) - 1)
End If
End If
End If
If (nUn <> 0 And nDec <> 1) Then
If (nUn = 1) Then
StringaInCostruzione = StringaInCostruzione & "uno"
Else
StringaInCostruzione = StringaInCostruzione & aUnita(nUn)
End If
End If
StringaInCostruzione = StrConv(StringaInCostruzione, vbProperCase)
If Len(sDecimali) > 0 Then
StringaInCostruzione = StringaInCostruzione & "/" & sDecimali
'* commentare [con un APICE SINGOLO A INIZIO RIGA]
'* le due righe sottostanti se NON si vuole l'aggiunta di /00
'* QUANDO NON CI SONO DECIMALI
Else
StringaInCostruzione = StringaInCostruzione & "/00"
End If
sCifraInLettere = StringaInCostruzione
End Function
-------------------------------------------------------------------------------------
Dimenticavo: usa la formula "= sCifraInLettere(sNum)" per leggere la casella con il numero da trasformare |
|
Top |
|
|
GrayWolf Dio maturo
Registrato: 03/07/05 16:24 Messaggi: 2325 Residenza: ... come frontiera i confini del mondo...
|
Inviato: 18 Ott 2008 19:52 Oggetto: |
|
|
ro76 ha scritto: | Ciao GrayWolf,
questa macro è proprio quello che cercavo. Ti ringrazio di averla resa disponibile.
C'è però un piccolo problema. Quando i numeri sono 28, 38, 48, 58, 68, 78, 88, 98 la conversione li trasforma in "ventiotto", "trentaotto", "quarantaotto" ecc.
Dovrebbe essere, invece, "ventotto", "trentotto", "quarantotto" ecc.
Insomma quando l'ultimo numero è otto andrebbe fatta la stessa conversione che si fa quando l'ultimo numero è uno.
Visto che io capisco poco di programmazione e non capisco dove dovrei modificare, saresti così gentile da apportare questa ulteriore modifica al codice?
Grazie! |
de nada
anzi, grazie a te della segnalazione
ecco qui la funzione riveduta e corretta per l'eliminazione dell'ultimo carattere della decina quando l'unità è 1 o 8
Codice: |
Function sCifraInLettere(CifraInNumero As Variant) As String
Dim CifraInCaratteri, StringaInCostruzione, PrimoCharMaiusc As String
Dim aUnita, aDecine, aCentin, aSottoVenti, a, b As Variant
Dim nUn, nDec, nCent, nMigl, nCentMigl As Integer
Dim nMilion, nDecMilion, nCentMilion As Integer
Dim sDecimali As String
Dim avTmp As Variant
If InStr(CifraInNumero, ",") > 0 Then
avTmp = Split(CifraInNumero, ",")
CifraInNumero = avTmp(0)
If Len(avTmp(1)) = 1 Then
sDecimali = avTmp(1) & "0"
Else
sDecimali = avTmp(1)
End If
End If
CifraInNumero = Replace(CifraInNumero, ".", "")
If Not IsNumeric(CifraInNumero) Then
MsgBox "la cella non contiene un valore numerico"
Exit Function
End If
'Assegamenti alle matrici: siccome la numerazione degli elementi in VB
'inizia da 0 mettiamo al primo posto una stringa vuota in modo
'che il primo elemento che conta sia all'indice 1 dell'array
'per non creare confusione dopo.
aUnita = Array("", "un", "due", "tre", "quattro", "cinque", _
"sei", "sette", "otto", "nove")
aDecine = Array("", "dieci", "venti", "trenta", "quaranta", _
"cinquanta", "sessanta", "settanta", _
"ottanta", "novanta")
aCentin = Array("", "cento", "duecento", "trecento", _
"quattrocento", "cinquecento", "seicento", _
"settecento", "ottocento", "novecento")
aSottoVenti = Array("", "dieci", "undici", "dodici", _
"tredici", "quattordici", _
"quindici", "sedici", "diciasette", _
"diciotto", "diciannove")
'Il codice seguente conserva la lunghezza della stringa a 9 caratteri
CifraInCaratteri = Trim(Str$(CifraInNumero))
If (Len(CifraInCaratteri) = 1) Then
CifraInCaratteri = "00000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 2) Then
CifraInCaratteri = "0000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 3) Then
CifraInCaratteri = "000000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 4) Then
CifraInCaratteri = "00000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 5) Then
CifraInCaratteri = "0000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 6) Then
CifraInCaratteri = "000" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 7) Then
CifraInCaratteri = "00" & CifraInCaratteri
ElseIf (Len(CifraInCaratteri) = 8) Then
CifraInCaratteri = "0" & CifraInCaratteri
End If
nUn = Val(Mid$(CifraInCaratteri, 9, 1))
nDec = Val(Mid$(CifraInCaratteri, 8, 1))
nCent = Val(Mid$(CifraInCaratteri, 7, 1))
nMigl = Val(Mid$(CifraInCaratteri, 6, 1))
nDecMigl = Val(Mid$(CifraInCaratteri, 5, 1))
nCentMigl = Val(Mid$(CifraInCaratteri, 4, 1))
nMilion = Val(Mid$(CifraInCaratteri, 3, 1))
nDecMilion = Val(Mid$(CifraInCaratteri, 2, 1))
nCentMilion = Val(Mid$(CifraInCaratteri, 1, 1))
If (nCentMilion <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMilion)
End If
If (nDecMilion <> 0) Then
If (nDecMilion < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMilion + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMilion)
End If
End If
If (nMilion <> 0 And nDecMilion <> 1) Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMilion)
End If
If (nCentMilion = 0 And nDecMilion = 0 And nMilion = 1) Then
StringaInCostruzione = StringaInCostruzione & "milione"
End If
If (nCentMilion <> 0 Or nDecMilion <> 0 Or nMilion > 1) Then
StringaInCostruzione = StringaInCostruzione & "milioni"
End If
If (nCentMigl <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCentMigl)
End If
If (nDecMigl <> 0) Then
If (nDecMigl < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nMigl + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDecMigl)
End If
End If
If (nMigl <> 0 And nDecMigl <> 1) Then
If (Not (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1)) _
Then
StringaInCostruzione = StringaInCostruzione & aUnita(nMigl)
End If
End If
If (nCentMigl <> 0 Or nDecMigl <> 0 Or nMigl <> 0) Then
If (nCentMilion = 0 _
And nDecMilion = 0 _
And nMilion = 0 _
And nCentMigl = 0 _
And nDecMigl = 0 _
And nMigl = 1) _
Then
StringaInCostruzione = StringaInCostruzione & "mille"
Else
StringaInCostruzione = StringaInCostruzione & "mila"
End If
End If
If (nCent <> 0) Then
StringaInCostruzione = StringaInCostruzione & aCentin(nCent)
End If
If (nDec <> 0) Then
If (nDec < 2) Then
StringaInCostruzione = StringaInCostruzione & aSottoVenti(nUn + 1)
Else
StringaInCostruzione = StringaInCostruzione & aDecine(nDec)
If CifraInCaratteri Mod 10 = 1 _
Or CifraInCaratteri Mod 10 = 8 Then
StringaInCostruzione = Left(StringaInCostruzione, Len(StringaInCostruzione) - 1)
End If
End If
End If
If (nUn <> 0 And nDec <> 1) Then
If (nUn = 1) Then
StringaInCostruzione = StringaInCostruzione & "uno"
Else
StringaInCostruzione = StringaInCostruzione & aUnita(nUn)
End If
End If
StringaInCostruzione = StrConv(StringaInCostruzione, vbProperCase)
If Len(sDecimali) > 0 Then
StringaInCostruzione = StringaInCostruzione & "/" & sDecimali
'* commentare [con un APICE SINGOLO A INIZIO RIGA]
'* le due righe sottostanti se NON si vuole l'aggiunta di /00
'* QUANDO NON CI SONO DECIMALI
Else
StringaInCostruzione = StringaInCostruzione & "/00"
End If
sCifraInLettere = StringaInCostruzione
End Function
|
è possibile fare una prova digitando i valori
18
28
38
48
58
68
78
88
98
in celle che abbiano formato numerico con due decimali e nella cella adiacente =sCifraInLettere(coordinate_della_cella_precedente)
quindi
se
A2 contiene 28,00
B2 conterrà =CifraInLettere(A2)
e così via |
|
Top |
|
|
ro76 Comune mortale
Registrato: 18/10/08 09:28 Messaggi: 2
|
Inviato: 19 Ott 2008 09:14 Oggetto: |
|
|
Grazie mille, GrayWolf! Funziona a meraviglia.
Un saluto |
|
Top |
|
|
|
|
Non puoi inserire nuovi argomenti Non puoi rispondere a nessun argomento Non puoi modificare i tuoi messaggi Non puoi cancellare i tuoi messaggi Non puoi votare nei sondaggi
|
|