Excel Vba rakamı yazı okunuş metnine çevirme

Post Reply
ahmet
Site Admin
Posts: 66
Joined: Tue Feb 23, 2021 6:54 pm

Excel Vba rakamı yazı okunuş metnine çevirme

Post by ahmet »

Excel'de VBA kısmının için sayfa > hesaplama içinden yaziyacevir fonksiyonunu çağırarak kullanabilirsiniz.

Code: Select all

Function yaziyacevir(rakam)
    Dim grup(5), sayi(10, 3), basamak(5), oku(3)
    sayi(0, 1) = "": sayi(0, 2) = "": sayi(0, 3) = ""
    sayi(1, 1) = "Yüz": sayi(1, 2) = "On": sayi(1, 3) = "Bir"
    sayi(2, 1) = "İkiYüz": sayi(2, 2) = "Yirmi": sayi(2, 3) = "İki"
    sayi(3, 1) = "ÜçYüz": sayi(3, 2) = "Otuz": sayi(3, 3) = "Üç"
    sayi(4, 1) = "DörtYüz": sayi(4, 2) = "Kırk": sayi(4, 3) = "Dört"
    sayi(5, 1) = "BeşYüz": sayi(5, 2) = "Elli": sayi(5, 3) = "Beş"
    sayi(6, 1) = "AltıYüz": sayi(6, 2) = "Aaltmış": sayi(6, 3) = "Altı"
    sayi(7, 1) = "YediYüz": sayi(7, 2) = "Yetmiş": sayi(7, 3) = "Yedi"
    sayi(8, 1) = "SekizYüz": sayi(8, 2) = "Seksen": sayi(8, 3) = "Sekiz"
    sayi(9, 1) = "DokuzYüz": sayi(9, 2) = "Doksan": sayi(9, 3) = "Dokuz"
    basamak(5) = "Trilyon"
    basamak(4) = "Milyar"
    basamak(3) = "Milyon"
    basamak(2) = "Bin"
    basamak(1) = ""
    lira = Int(rakam)
    kurus = Round(rakam - lira, 2) * 100
    If Len(lira) > 15 Then
        MsgBox ("Bu fonksiyon en fazla 15 haneli sayılar için çalışır.")
        End
    End If
    kalan = lira
    yaziyacevir = ""
    
    For x = 1 To 5
        a = 15 - 3 * x
        If Len(lira) > a Then
            grup(6 - x) = Int(kalan / 10 ^ a)
            kalan = kalan - (grup(6 - x) * 10 ^ a)
        End If
    Next x
    
    If grup(5) > 0 Then
        oku(1) = Int(grup(5) / 100)
        baskalan = grup(5) - oku(1) * 100
        oku(2) = Int(baskalan / 10)
        oku(3) = baskalan - oku(2) * 10
        yaziyacevir = sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(5)
    End If
    
    If grup(4) > 0 Then
        oku(1) = Int(grup(4) / 100)
        baskalan = grup(4) - oku(1) * 100
        oku(2) = Int(baskalan / 10)
        oku(3) = baskalan - oku(2) * 10
        yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(4)
    End If
    
    If grup(3) > 0 Then
        oku(1) = Int(grup(3) / 100)
        baskalan = grup(3) - oku(1) * 100
        oku(2) = Int(baskalan / 10)
        oku(3) = baskalan - oku(2) * 10
        yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(3)
    End If
    
    If grup(2) = 1 Then
        yaziyacevir = yaziyacevir + "BİN"
    End If
    
    If grup(2) > 1 Then
        oku(1) = Int(grup(2) / 100)
        baskalan = grup(2) - oku(1) * 100
        oku(2) = Int(baskalan / 10)
        oku(3) = baskalan - oku(2) * 10
        yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(2)
    End If
    
    If grup(1) > 0 Then
        oku(1) = Int(grup(1) / 100)
        baskalan = grup(1) - oku(1) * 100
        oku(2) = Int(baskalan / 10)
        oku(3) = baskalan - oku(2) * 10
        yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(1)
    End If
    yaziyacevir = yaziyacevir + " TL."
    If kurus > 0 Then
        oku(2) = 0
        If Len(kurus) > 1 Then
            oku(2) = Int(kurus / 10)
        End If
        oku(3) = kurus - oku(2) * 10
        yaziyacevir = yaziyacevir + sayi(oku(2), 2) + sayi(oku(3), 3) + " KR."
    End If
End Function
Post Reply