Rakamı yazıya çevirme

[othara]

[TR][TD]
arkadaslar rakamı su sekılde nasıl yapabilirim..yardımlarınız ıcın tesekkurler simdiden

41.867,00 TL

#Kırk Bir Bin Sekiz Yüz Altmış Yedi TL.#
[/TD]
[TD]

[/TD][/TR]

 

[Korhan Ayhan]

Merhaba,

Formumuzda bu konuyla ilgili ayrı bir bölüm var. İnceleyiniz.

Sayıyı Yazıya Çevirme Uygulamaları

Bu başlıkta, Türkçe ve ingilizce olarak sayıyı yazıya çevirme ve YTL-YKR uygulamalarını bulabilirsiniz.

www.excel.web.tr

 

[Korhan Ayhan]

Konu başlıklarınızı forum kurallarına uygun şekilde tercih ederseniz seviniriz.

 

[OzNvl]

arkadaslar rakamı su sekılde nasıl yapabilirim..yardımlarınız ıcın tesekkurler simdiden

41.867,00 TL

#Kırk Bir Bin Sekiz Yüz Altmış Yedi TL.#



Aşağıdaki fonksiyonu kullanınız.


Function Sayıyı_Yazıya_Çevir(Tutar As Currency) As String
Dim Tutar_Standart As String
Dim Nokta_Sayısı As Byte
Dim Noktanın_Yeri() As Byte
Dim i As Byte
Dim j As Byte
Dim Virgülden_Önce
Dim Virgülden_Sonra
Dim Noktadan_Önce
Dim Büyük_Değer(1 To 6) As String
Tutar_Standart = Format(Tutar, "#,0")
Büyük_Değer(1) = ""
Büyük_Değer(2) = " bin "
Büyük_Değer(3) = " milyon "
Büyük_Değer(4) = " milyar "
Büyük_Değer(5) = " trilyon "
Büyük_Değer(6) = " katrilyon "

'Virgülden_Sonra = Right(Tutar_Standart, 3)
'If Virgülden_Sonra = ",00" Then Virgülden_Sonra = "0"
Virgülden_Önce = Tutar_Standart ' Left(Tutar_Standart, Len(Tutar_Standart) - 3)
Noktadan_Önce = Len(Virgülden_Önce) Mod 4
Select Case Len(Virgülden_Önce)
Case 1 To 3
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Virgülden_Önce)
Case 5 To 7
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Len(Virgülden_Önce) - 4)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Right(Virgülden_Önce, 3))
Case 9 To 11
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3))
Case 13 To 15
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3))
Case 17 To 19
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 14, 3))
Case 21 To 23
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(6) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 14, 3)) & Büyük_Değer(6) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 18, 3))
End Select
Sayıyı_Yazıya_Çevir = Sayıyı_Yazıya_Çevir ' & " lira " & Üç_Basamaklı_Yazı(Right(Virgülden_Sonra, 2)) & " Kuruş"
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Proper(Sayıyı_Yazıya_Çevir)
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Trim(Sayıyı_Yazıya_Çevir)
If Left(Sayıyı_Yazıya_Çevir, 7) = "Bir Bin" Then
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Bir Bin", "Bin")

End If
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Sıfır Lira", "Lira")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Milyon Sıfır Bin", "Milyon")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Lira", "Nokta")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Kuruş", "")
'If Right(Tutar_Standart, 2) = "00" Then
'Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, " Nokta Sıfır ", "")
'Sayıyı_Yazıya_Çevir = Left(Sayıyı_Yazıya_Çevir, Len(Sayıyı_Yazıya_Çevir) - 1)

'End If
'Sayıyı_Yazıya_Çevir = Sondan_İkinci_Boşluk_Bul(Sayıyı_Yazıya_Çevir)
'If IsNumeric(Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find("Nokta", Sayıyı_Yazıya_Çevir) + 1) + 1) + 1)) = False Then

'Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, " Nokta", "Nokta Sıfır")

'End If
End Function
Function Üç_Basamaklı_Yazı(Sayı)
Dim Uzunluk As Byte
Sayı = Int(Sayı)
Sayı = CStr(Sayı)
Uzunluk = Len(Sayı)
If Sayı = 0 Then
Üç_Basamaklı_Yazı = "sıfır"
Exit Function
End If
Select Case Uzunluk
Case 1
Üç_Basamaklı_Yazı = Choose(Sayı, "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Case 2
a = Choose(Mid(Sayı, 1, 1), "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
If Mid(Sayı, 2, 1) = 0 Then
b = ""
Else
b = Choose(Mid(Sayı, 2, 1), "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
End If
Üç_Basamaklı_Yazı = a & " " & b
Case 3
a = Choose(Mid(Sayı, 1, 1), "", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz") & " yüz"
If Mid(Sayı, 2, 1) = 0 Then
b = ""
Else
b = Choose(Mid(Sayı, 2, 1), "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
End If
If Mid(Sayı, 3, 1) = 0 Then
c = ""
Else
c = Choose(Mid(Sayı, 3, 1), "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
End If
Üç_Basamaklı_Yazı = a & " " & b & " " & c
End Select
End Function
Function Sondan_İkinci_Boşluk_Bul(İfade)
Dim Nokta_Yeri As Integer
Dim Adet As Byte
Nokta_Yeri = Application.WorksheetFunction.Find("Nokta", İfade)
For i = Len(İfade) To Nokta_Yeri Step -1
If Mid(İfade, i, 1) = " " Then
Adet = Adet + 1
End If
Next i
If Adet