Excel – Rakamı TL – Kr ye Çevirme Makrosu

Sayıların Rakama çevrilmesi ile ilgili bir excel çalışması bu bölümde verilmişti. Bu makro ise girilen rakamların TL ve KR ye çevrilmesini sağlıyor. Girilen sayının Tamsayı bölümü YTL, Ondalık kısmı ise Kr olarak yazıya çevriliyor.

Not: Kodlarda geçen YTL ve YKr ifadelerini TL ve Kr olarak değiştiriniz.

Bu konu anlatımının uygulandığı Excel çalışmasını alttaki linkten indirebilirsiniz.

Boyut: 12 KB

Tür	zip
Boyut	12,0 KiB
İndirme	700 kez
Yükleme linki	YTL - YKR Ceviri Makrosu

Örnek: 10,05 On TL, Beş Kr şeklinde.  Makronun kullanımı: A1 hücresindeki rakamı A2 hücresinde yazıya çevirmek için,

=YeniTL(A1)

Makro Kodu ise aşağıdaki gibi:

Sub YTL()
End Sub
Function YeniTL(sayi, Optional tür As Byte = 0)
'Rakamı yeni türk lirası türünden belirt
'
'Makro S Şahin tarafından kaydedildi
'Stil =0 YTL ve YKR
'      1 Yalnız YTL
'      2 Tam sayı ise yalnız YTL
Dim tam
Dim küsur As Byte
Dim syazi As String
If IsNumeric(sayi) And Len(Format(sayi)) < 16 Then
sayi = Int(sayi * 100) / 100
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
tam = Int(sayi)
küsur = (sayi - tam) * 100
syazi = syazi & yçevir(tam) & " YTL "
If tür = 0 Or (tür = 2 And küsur <> 0) Then
syazi = syazi & yçevir(küsur) & " YKR"
End If
Else
syazi = "Hata"
End If
YeniTL = syazi
End Function
Function yçevir(csayi)
Dim birler, onlar, bsayi
Dim rakamlar(1 To 15) As Byte
Dim yazi As String, syazi As String
Dim uz As Byte
Dim m
Dim sayi As String
Dim bs As Byte
Dim art As Byte
Dim rakam As Byte
birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
onlar = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
bsayi = Array("", "Bin ", "Milyon ", "Milyar ", "Trilyon ")
sayi = Format(csayi)
uz = Len(sayi)
For m = uz To 1 Step -1
art = art + 1
rakamlar(art) = Val(Mid(sayi, m, 1))
Next
For bs = 1 To uz
art = bs Mod 3
rakam = rakamlar(bs)
yazi = ""
Select Case art
Case 1
yazi = birler(rakam) & bsayi(Int(bs / 3))
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
Case 2
yazi = onlar(rakam)
Case 0
If rakam = 0 Then
yazi = ""
ElseIf rakam = 1 Then
yazi = "Yüz"
Else
yazi = birler(rakam) & "Yüz"
End If
End Select
syazi = yazi & syazi
Next
If syazi = "" Then
syazi = "Sıfır"
Else
syazi = Replace(syazi, " Bin ", "")
syazi = Replace(syazi, " Milyar ", "")
syazi = Replace(syazi, " Milyon ", "")
End If
yçevir = syazi
End Function