Excel’de Sayıyı Yazıya Çevirmek – (TL – Krş) Para Tutarını Yazıya Çevirmek

Public Function YAZIYACEVIR(Para_Tutar)

Dim Para_TutarStr As String
Dim ParaBirimi As String, ParaAltBirimi As String
HücreAdı = Para_Tutar.Address
If Para_Tutar = “” Then
YAZIYACEVIR = HücreAdı & ” Hücresine bir değer girmelisiniz !…”
Exit Function
End If
If Not IsNumeric(Para_Tutar) Then
YAZIYACEVIR = HücreAdı & ” Hücresine girilen değer, sayı değil !…”
Exit Function
End If
ParaStr = Format(Abs(Para_Tutar), “0.00”)
ParaBirimi = Left(ParaStr, Len(ParaStr) – 3)
ParaAltBirimi = Right(ParaStr, 2)
YAZIYACEVIR = IIf(Para_Tutar = 0, “Yalnız ” & Cevir(ParaBirimi) & ” TL “, “”) & _
IIf(Para_Tutar <> 0, “Yalnız “, “”) & _
IIf(Para_Tutar < 0, “Eksi (-) “, “”) & _ IIf(Para_Tutar <> 0, Cevir(ParaBirimi) & ” TL “, “”) & _
IIf(Val(ParaAltBirimi) <> 0, Cevir(ParaAltBirimi) & ” Kr.”, “”)
If ParaBirimi = 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = “Yalnız ” & Cevir(ParaAltBirimi) & ” Kr.”
If Para_Tutar < 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = “Yalnız Eksi (-) ” & Cevir(ParaAltBirimi) & ” Kr.”
End If
End If
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

Kullanımı:
=YAZIYACEVIR(HücreAdresi)

Diğer örnekler için:
http://www.excelce.net/forum/index.php?topic=358.0

Ek:

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir