-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Rayman15
csendes tag
Nekem is ugyanez lenne a kérdésem: megoldható e az, hogy egy megadott számot betűvel írjon ki a program, magyarul? A neten böngészve találtam vmit, viszont ehhez teljesen láma vagyok, ha vki leírná pontosan,hogy hogyan tudnám használni,nagyon hálás lennék. Na szóval itt van:
Function ftszoveg(ft)
Dim n1(9), n2(9)
n1(1) = ''egy''
n1(2) = ''kettő''
n1(3) = ''három''
n1(4) = ''négy''
n1(5) = ''öt''
n1(6) = ''hat''
n1(7) = ''hét''
n1(8) = ''nyolc''
n1(9) = ''kilenc''
n2(1) = ''tíz''
n2(2) = ''húsz''
n2(3) = ''harminc''
n2(4) = ''negyven''
n2(5) = ''ötven''
n2(6) = ''hatvan''
n2(7) = ''hetven''
n2(8) = ''nyolcvan''
n2(9) = ''kilencven''
w = ''''
wo = Format$(ft, ''000000000'')
w1 = CInt(Mid$(wo, 1, 1))
If w1 <> 0 Then
w = w + n1(w1) + ''száz''
End If
w2 = CInt(Mid$(wo, 2, 1))
If w2 <> 0 Then
w = w + n2(w2)
End If
w3 = CInt(Mid$(wo, 3, 1))
If w3 <> 0 Then
If w2 = 1 Then
w = w + ''en''
End If
If w2 = 2 Then
w = w + ''on''
End If
w = w + n1(w3)
End If
If w1 + w2 + w3 <> 0 Then
w = w + ''millió''
End If
w1 = CInt(Mid$(wo, 4, 1))
If w1 <> 0 Then
w = w + n1(w1) + ''száz''
End If
w2 = CInt(Mid$(wo, 5, 1))
If w2 <> 0 Then
w = w + n2(w2)
End If
w3 = CInt(Mid$(wo, 6, 1))
If w3 <> 0 Then
If w2 = 1 Then
w = w + ''en''
End If
If w2 = 2 Then
w = w + ''on''
End If
w = w + n1(w3)
End If
If w1 + w2 + w3 <> 0 Then
w = w + ''ezer''
End If
w1 = CInt(Mid$(wo, 7, 1))
If w1 <> 0 Then
w = w + n1(w1) + ''száz''
End If
w2 = CInt(Mid$(wo, 8, 1))
If w2 <> 0 Then
w = w + n2(w2)
End If
w3 = CInt(Mid$(wo, 9, 1))
If w3 <> 0 Then
If w2 = 1 Then
w = w + ''en''
End If
If w2 = 2 Then
w = w + ''on''
End If
w = w + n1(w3)
End If
If IsNull(w) Then
w = Mid$(w, 2, Len(w) - 1)
Else
w = UCase$(Left$(w, 1)) + Mid$(w, 2, Len(w) - 1)
End If
ftszoveg = w
End Function
Új hozzászólás Aktív témák
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Xbox Series X|S
- Fujifilm X
- A fociról könnyedén, egy baráti társaságban
- Honor Magic6 Pro - kör közepén számok
- Xiaomi 15T Pro - a téma nincs lezárva
- Starlink
- Kötelező frissítésnek számít a Microsoft legújabb csomagja a Windows 11-hez
- Szomjan halunk, míg az AI dolgozik
- Mi lesz a Facebook fiókoddal, ha meghalsz?
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- MS SQL Server 2016, 2017, 2019
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- HIBÁTLAN iPhone 13 128GB Blue-1 ÉV GARANCIA - Kártyafüggetlen, MS4453, 100% Akksi
- Dell Optiplex 3050 SFF,i5-6500,8GB DDR4,256GB SSD, WIN11
- Gamer/streamer mikrofon, állvány és USB HUB kitűnő árakon!
- HP Elitebook 840 G3,FHD,14",i5-6300U,8GB DDR4,256GB SSD,WIN11
- 27% - LG 75NANO756QA 190CM NANOLED 4K UHD 100HZ SMART TV ! BeszámítOK !
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50