SAYIYI YAZIYA ÇEVİRME

[centirmen]

buyrun bir örnek daha gönderiyorum
formül olarak hücreye giriniz

=ParaCevir(X56;"TL";"Kr")

Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruş")
Dim ParaStr As String
Dim Lira As String, Kurus As String
If Not IsNumeric(Para) Then
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If
ParaStr = Format(Abs(Para), "0.00")
Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
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 = "Sıfır"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

örnek dosya ektedir.

merhaba bu formül benimde işime yaradı süper de
mesela (50,20) Elli tl yirmi kuruş diyor
ben birleşik yazmasını istiyorum ellitlyirmikuruş bu şekil yazma şansımız var mı?

 

[mancubus]

aşağıdaki kodu

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")

şekline dönüştürün.

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & PBirim & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & KBirim & " ", "")

 

[centirmen]

eywalllah hocam elinize sağlık

 

[mancubus]

rica ederim.

 

[halil_ibo]

arkadaşlar yardımınıza ihtiyacım var excelde hazırlamıs olduğum ve bankaya tahsile vereceğim senetlerin bodrosunun yukarıdaki açıklama kısmında otomatik olarak adetini ve meblağını yazdırmak istiyorum. örneğini ekte gönderdim yardımcı olursanız sevinirim...

 

[Erdal]

Merhabalar
Eki inceleyiniz.