Sayıyı Tl Ve Krş a Çevirme Yardımm

[strayker]

Elimde bulmuş olduğum bir formul var, bir türlü doğru girişleri yapamıyorum, bu konuda yardımcı olursanız çok sevinirim. Excel de hazırlamış olduğum fatura programımda rakamları yazıya dönüştürmek istiyorum..
Fonksiyon Şu şekilde:

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 TL = son & "TL"
If g = 2 And deger(2) <> 0 Then KRŞ = " " & son & "KRŞ"
son = ""
e = 0
Next
yaziyla = TL & KRŞ
End Function

 

[Korhan Ayhan]

Selamlar,

Dosyanızı eklermisiniz.

 

[irfancantr]

http://www.excel.web.tr/showthread.php?t=12077&highlight=rakam+yaz%FDya+%E7evir

 

[mustafakoker]

Elimde bulmuş olduğum bir formul var, bir türlü doğru girişleri yapamıyorum, bu konuda yardımcı olursanız çok sevinirim. Excel de hazırlamış olduğum fatura programımda rakamları yazıya dönüştürmek istiyorum..




EKLİ DOSYAYI İNCELERMISINIZ SİZİN İÇİN BASİT BİR FATURA ÖRNEĞİ

AYRICA KODLARI

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

UMARIM İŞİNİZE YARAR