Kaynak ikonu

Excel'de Rakamı YTL - YKr ye Çevirme Makrosu -

İndirmek için giriş yapınız
Sayıların Rakama çevrilmesi ile ilgili bir excel çalışması bu bölümde verilmişti. Bu makro girilen rakamların YTL ve YKR ye çevrilmesini sağlıyor^^ Girilen sayının Tamsayı bölümü YTL, Ondalık kısmı ise YKr olarak yazıya çevriliyor.

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

Örnek: 10,05 On YTL, Beş YKr şeklinde.

Makronun kullanımı: A1 hücresindeki rakamı A2 hücresinde yazıya çevirmek için,
Kod:
=YeniTL(A1)
Makro Kodu ise aşağıdaki gibi:
Kod:
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
Gönderen
YoRuMSuZ
İndirilme
0
İlk yayınlama
Son güncelleme
Değerlendirme
0.00 star(s) 0 ratings

YoRuMSuZ ait diğer kaynakar

Top