rakamın yazıyla yazılması formülü?

[faceturk]

Değerli forumdaşlar excel de a 1 deki 150,45 ytl rakamını a 2 ye nasıl "Yüzelli YTL, Kırkbeş YKR" yazırabilirim.
Yardımlarınızı bekler saygılarımı sunarım.

 

[Ömer]

Merhaba,

Linki incelermisiniz..

Sayıyı Yazıya Çevirme Uygulamaları

 

[ECYavuz]

A2 e =yaziyla("A1") yazıp aşağıdaki kodu modüle atayın..

Function yaziyla(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
b = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
c = Array("", "", "bin", "milyon", "milyar", "trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "yüz", "biryüz", "yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "birbin" Then son = Replace(son, "birbin", "bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then ytl = son & " YTL"
If g = 2 And deger(2) <> 0 Then ykr = " " & son & " YKR"
son = ""
e = 0
Next
yaziyla = ytl & ykr
End Function

 

[ismailmuhcu]

3 Nolu mesajda kullanılan fonksiyon 1,00 şeklindeki parasal tutarlarda "Sıfır YKR" yazmaz. Onun da görünmesini isterseniz;

Public Function ParaCevir(Para)
 Dim ParaStr As String
 Dim YTL As String, Kurus As String
 
 If Not IsNumeric(Para) Then GoTo SayiDegil
 
 ParaStr = Format(Abs(Para), "0.00")
 
 YTL = Left(ParaStr, Len(ParaStr) - 3)
 Kurus = Right(ParaStr, 2)
 
 ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & " YTL ve " & Cevir(Kurus) & " YKR"
 
 Exit Function
 
SayiDegil:
 ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Private Function Cevir(SayiStr As String) As String
 Dim Rakam(15)
 Dim c(3), Sonuc, e
 
 Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
 Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
 Binler = Array("trilyon", "milyar", "milyon", "bin", "")
 
 SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
 
 For i = 1 To 15
 Rakam(i) = Val(Mid$(SayiStr, i, 1))
 Next i
 
 Sonuc = ""
 For i = 0 To 4
 c(1) = Rakam(i * 3 + 1)
 c(2) = Rakam(i * 3 + 2)
 c(3) = Rakam(i * 3 + 3)
 If c(1) = 0 Then
 e = ""
 ElseIf c(1) = 1 Then
 e = "yüz"
 Else
 e = Birler(c(1)) + "yüz"
 End If
 e = e + Onlar(c(2)) + Birler(c(3))
 If e <> "" Then e = e + Binler(i)
 If (i = 3) And (e = "birbin") Then e = "bin"
 Sonuc = Sonuc + e
 Next i
 If Sonuc = "" Then Sonuc = "00"
 
 Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

Fonksiyonunu kullanın...

3.Nolu mesajda ayrıca 1000000000000000 değeri için "ononbeşYTL" değerini veriyor...