Olimpo Informatico

[nero.bm]

Con la macro funziona, ma con il richiamo diretto della funzione nella forma =sCifraInLettere(coordinate_della _cella) no ancora.

[GrayWolf]

strano...

hai apportato tutte e due le modifiche?

la seconda l'ho aggiunta forse mentre stavi leggendo...

[GrayWolf]

hai ragione... quando deve decodificare una sommatoria fa casino

per tagliare la testa al toro [povero toro]

fai quest'altra modifica

l'istruzione:
da:

[ro76]

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!

[nero.bm]

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

[GrayWolf]

[ro76]

Grazie mille, GrayWolf! Funziona a meraviglia.

Un saluto