Új hozzászólás Aktív témák

• #8395 Delila_1 veterán xKacsax #8392

  Új Válasz 2010-10-08 18:23:46 #8395

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz xKacsax #8392 üzenetére

  Kilencszázkilencvenkilencmillió-kilencszázkilencvenkilencezer-kilencszázkilencvenkilenc-ig kiírja betűvel az összeget ez a függvény, amit nem én írtam, csak alkalmazom néhanapján.

  Function Szam_szoveg(szam As Long) As String
  Dim j1, j10, j10a, j100
  j1 = Array("", "egy", "kettő", "három", "négy", "öt", "hat", "hét", "nyolc", "kilenc")
  j10 = Array("", "tíz", "húsz", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")
  j10a = Array("", "tizen", "huszon", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")
  j100 = Array("száz", "", "ezer", "millió", "milliárd")
  betu = ""
  If szam = 0 Then
  Szam_szoveg = "Nulla"
  Exit Function
  End If
  s = Format(szam, "0")
  j = 1
  While s <> ""
  i = Len(s) - 2
  If i < 1 Then i = 1
  s2 = Mid(s, i, 3)
  s = Left(s, i - 1)
  s3 = ""
  If Len(s2) = 3 Then
  s3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)
  If Mid(s2, 1, 1) <> "0" Then s3 = s3 + j100(0)
  s2 = Right(s2, Len(s2) - 1)
  End If
  If Len(s2) = 2 Then
  If Mid(s2, 2, 1) = "0" Then
  s3 = s3 + j10(Asc(Mid(s2, 1, 1)) - 48)
  Else
  s3 = s3 + j10a(Asc(Mid(s2, 1, 1)) - 48)
  End If
  s2 = Right(s2, Len(s2) - 1)
  End If
  s3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)
  If s3 <> "" Then s3 = s3 + j100(j)
  If (betu <> "") And (szam > 2000) And (s3 <> "") Then kot = "-" Else kot = ""
  betu = s3 + kot + betu
  j = j + 1
  Wend
  betu = UCase(Left(betu, 1)) & Right(betu, Len(betu) - 1)
  Szam_szoveg = betu
  End Function

  Alkalmazása: a cellába =Szam_szoveg(A1) – ha a szám, amit betűvel akarsz kiíratni, az A1 cellában van.
  Azt is tudja, hogy kétezer alatt egybe kell írni az összegeket szöveggel, azon felül a hármas tagolás van érvényben. Állítólag már nem kell nagybetűvel kezdeni, akkor az utolsó előtti sort [betu = UCase(Left(betu, 1)) & Right(betu, Len(betu) - 1)] töröld ki, vagy tedd megjegyzésbe.

Új hozzászólás Aktív témák