Indice del forum Olimpo Informatico
I Forum di Zeus News
Leggi la newsletter gratuita - Attiva il Menu compatto
 
 FAQFAQ   CercaCerca   Lista utentiLista utenti   GruppiGruppi   RegistratiRegistrati 
 ProfiloProfilo   Messaggi privatiMessaggi privati   Log inLog in 

    Newsletter RSS Facebook Twitter Contatti Ricerca
Excel: Ricavare numero in lettere da quello in cifre
Nuovo argomento   Rispondi    Indice del forum -> Office e LibreOffice
Precedente :: Successivo  
Autore Messaggio
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 05 Ott 2008 19:05    Oggetto: Excel: Ricavare numero in lettere da quello in cifre Rispondi citando

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
Profilo Invia messaggio privato
chemicalbit
Dio maturo
Dio maturo


Registrato: 01/04/05 17:59
Messaggi: 18597
Residenza: Milano

MessaggioInviato: 05 Ott 2008 22:08    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 07 Ott 2008 20:20    Oggetto: Rispondi citando

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 Wink
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:


  1. da menu : creare una macro con:
    Strumenti ->Macro ->Macro -> Crea
    fornire il nome [nell'esempio l'ho chiamata Trasforma]
  2. 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]
  3. dopo la riga contenente End sub copiare/incollare TUTTO il codice della funzione, [nome compreso]
  4. Fatto!
  5. 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]

  6. eseguire la macro
  7. 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
  8. 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
Profilo Invia messaggio privato
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 09 Ott 2008 11:38    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 09 Ott 2008 12:47    Oggetto: Rispondi citando

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... Smile
devo lavorarci un po'...

Le domande sono:

  1. la transcodifica letterale dei centesimi deve essere come negli assegni? [cioè, a esempio: cento/37 dove 37 naturalmente sono i centesimi]
  2. come esprimi il numero con i centesimi? [con la notazione italiana, a esempio: 100,37]
Top
Profilo Invia messaggio privato
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 09 Ott 2008 13:41    Oggetto: Rispondi citando

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!!!!

Smile
Top
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 09 Ott 2008 22:11    Oggetto: Rispondi citando

Ecco qua, la nuova versione

Modifiche apportate
Citazione:

  1. troncata l'ultima lettera della decina quando seguita da 1
  2. inserito il controllo di numericità
    [se la cella contiene un valore non numerico è prodotto un messaggio]
  3. filtrato il valore, eliminando gli eventuali punti di separazione delle migliaia
  4. 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:

  1. 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

  2. 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
Profilo Invia messaggio privato
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 10 Ott 2008 16:11    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
chemicalbit
Dio maturo
Dio maturo


Registrato: 01/04/05 17:59
Messaggi: 18597
Residenza: Milano

MessaggioInviato: 10 Ott 2008 17:06    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 10 Ott 2008 19:37    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 10 Ott 2008 19:57    Oggetto: Rispondi citando

Con la macro funziona, ma con il richiamo diretto della funzione nella forma =sCifraInLettere(coordinate_della _cella) no ancora.
Top
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 10 Ott 2008 19:59    Oggetto: Rispondi citando

strano...

hai apportato tutte e due le modifiche?

la seconda l'ho aggiunta forse mentre stavi leggendo...
Top
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 10 Ott 2008 20:21    Oggetto: Rispondi citando

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

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
Profilo Invia messaggio privato
ro76
Comune mortale
Comune mortale


Registrato: 18/10/08 09:28
Messaggi: 2

MessaggioInviato: 18 Ott 2008 09:47    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
nero.bm
Eroe in grazia degli dei
Eroe in grazia degli dei


Registrato: 02/10/08 15:51
Messaggi: 105

MessaggioInviato: 18 Ott 2008 19:20    Oggetto: Rispondi citando

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
Profilo Invia messaggio privato
GrayWolf
Dio maturo
Dio maturo


Registrato: 03/07/05 16:24
Messaggi: 2325
Residenza: ... come frontiera i confini del mondo...

MessaggioInviato: 18 Ott 2008 19:52    Oggetto: Rispondi citando

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 Smile
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
Profilo Invia messaggio privato
ro76
Comune mortale
Comune mortale


Registrato: 18/10/08 09:28
Messaggi: 2

MessaggioInviato: 19 Ott 2008 09:14    Oggetto: Rispondi

Grazie mille, GrayWolf! Funziona a meraviglia.

Un saluto
Top
Profilo Invia messaggio privato
Mostra prima i messaggi di:   
Nuovo argomento   Rispondi    Indice del forum -> Office e LibreOffice Tutti i fusi orari sono GMT + 1 ora
Pagina 1 di 1

 
Vai a:  
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