TRANSFORMARE CIFRE IN LITERE

[cosanostra]

Buna ziua

Sunt la inceputul "pionieratului meu" in Excel

Cum se poate transforma o valoare ex.: 1420.42 lei in litere intr-o casuta (=celula n. IPP) alaturata?

[IPP]

Buna ziua

Pentru inceput:
-va rugam sa nu mai scrieti (exclusiv) cu majuscule. Se poate interpreta gresit mesajul dvs.
-incercati sa folositi instrumentul de cautare pe forum. Exista sanse sa nu fiti nevoit sa deschideti un topic nou. In cazul problemei dvs. este nevoie de VBA si puteti Vedea subiectul Functie UDF pentru conversie cifre in cuvinte

IP

[Catalin B.]

Există un cod creat de microsoft, la care limita de suma este de ordinul trilioanelor, care, modificat pentru Romania, arată aşa:

Cod: Selectaţi tot

 '****************
      ' Main Function *
 
      '****************
 
 
 
      Function SpellNumber(ByVal MyNumber)
 
          Dim Dollars, Cents, Temp
 
          Dim DecimalPlace, Count
 
 
 
          ReDim Place(9) As String
 
          Place(2) = "mii"
 
          Place(3) = "milioane"
 
          Place(4) = "miliarde"
 
          Place(5) = "trilioane"
 
 
 
          ' String representation of amount.
 
          MyNumber = Trim(Str(MyNumber))
 
 
 
          ' Position of decimal place 0 if none.
 
          DecimalPlace = InStr(MyNumber, ".")
 
          ' Convert cents and set MyNumber to dollar amount.
 
          If DecimalPlace > 0 Then
 
              Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
 
              MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
 
          End If
 
 
 
          Count = 1
 
          Do While MyNumber <> ""
 
              Temp = GetHundreds(Right(MyNumber, 3))
 
              If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
 
              If Len(MyNumber) > 3 Then
 
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
 
              Else
 
                  MyNumber = ""
 
              End If
 
              Count = Count + 1
 
          Loop
 
 
 
          Select Case Dollars
 
              Case ""
 
                  Dollars = "zerolei"
 
              Case "One"
 
                  Dollars = "unleu"
 
              Case Else
 
                  Dollars = Dollars & "lei"
 
          End Select
 
 
 
          Select Case Cents
 
              Case ""
 
                  Cents = "şizerobani"
 
              Case "One"
 
                  Cents = "şiunban"
 
              Case Else
 
                  Cents = "şi" & Cents & "bani"
 
          End Select
 
 
 
          SpellNumber = Dollars & Cents
 
      End Function
 
 
 
 
 
 
 
      '*******************************************
 
      ' Converts a number from 100-999 into text *
 
      '*******************************************
 
 
 
      Function GetHundreds(ByVal MyNumber)
 
          Dim Result As String
 
 
 
          If Val(MyNumber) = 0 Then Exit Function
 
          MyNumber = Right("000" & MyNumber, 3)
 
 
 
          ' Convert the hundreds place.
 
          If Mid(MyNumber, 1, 1) <> "0" Then
 
              Result = GetDigit(Mid(MyNumber, 1, 1)) & "sute"
 
          End If
 
 
 
          ' Convert the tens and ones place.
 
          If Mid(MyNumber, 2, 1) <> "0" Then
 
              Result = Result & GetTens(Mid(MyNumber, 2))
 
          Else
 
              Result = Result & GetDigit(Mid(MyNumber, 3))
 
          End If
 
 
 
          GetHundreds = Result
 
      End Function
 
 
 
 
 
 
 
      '*********************************************
 
      ' Converts a number from 10 to 99 into text. *
 
      '*********************************************
 
 
 
     Function GetTens(TensText)
 
          Dim Result As String
 
 
 
          Result = ""           ' Null out the temporary function value.
 
          If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
 
              Select Case Val(TensText)
 
                  Case 10: Result = "zece"
 
                  Case 11: Result = "unsprezece"
 
                  Case 12: Result = "douãsprezece"
 
                  Case 13: Result = "treisprezece"
 
                  Case 14: Result = "patrusprezece"
 
                  Case 15: Result = "cincisprezece"
 
                  Case 16: Result = "şaisprezece"
 
                  Case 17: Result = "şaptesprezece"
 
                  Case 18: Result = "optsprezece"
 
                  Case 19: Result = "nouãsprezece"
 
                  Case Else
 
              End Select
 
          Else                                 ' If value between 20-99...
 
              Select Case Val(Left(TensText, 1))
 
                  Case 2: Result = "douãzecişi"
 
                  Case 3: Result = "treizecişi"
 
                  Case 4: Result = "patruzecişi"
 
                  Case 5: Result = "cincizecişi"
 
                  Case 6: Result = "şaizecişi"
 
                  Case 7: Result = "şaptezecişi"
 
                  Case 8: Result = "optzecişi"
 
                  Case 9: Result = "nouãzecişi"
 
                  Case Else
 
              End Select
 
              Result = Result & GetDigit(Right(TensText, 1))   ' Retrieve ones place.
 
          End If
 
          GetTens = Result
 
      End Function
 
 
 
 
 
 
 
 
 
      '*******************************************
 
      ' Converts a number from 1 to 9 into text. *
 
      '*******************************************
 
 
 
      Function GetDigit(Digit)
 
          Select Case Val(Digit)
 
              Case 1: GetDigit = "unu"
 
              Case 2: GetDigit = "doi"
 
              Case 3: GetDigit = "trei"
 
              Case 4: GetDigit = "patru"
 
              Case 5: GetDigit = "cinci"
 
              Case 6: GetDigit = "şase"
 
              Case 7: GetDigit = "şapte"
 
              Case 8: GetDigit = "opt"
 
              Case 9: GetDigit = "nouã"
 
              Case Else: GetDigit = ""
 
          End Select
 
      End Function

Pentru a utiliza codul, deschide VB Editor, inserează modul nou şi copiază codul in fereastra din dreapta.
În foaia excel, scrie formula =SpellNumber(A1) , unde A1 este valoarea pe care vrei să o transformi în litere...

[mrlpls]

După ce inserezi codul de mai sus, în celula A2 poți folosi formula:

Cod: Selectaţi tot

=SpellNumber(VALUE(A1))

unde A1 este celula care conține valoarea pe care vrei să o transformi

[Daniel Gradinar]

Buna ziua,

Ar mai fi mici corectii de facut aspura acelui cod. Am incercat sa gasesc cum se corecteaza dar nu m-am descurcat
Am atasat fisierul in cauza