rakamı yazıya çevirme makrosu Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
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) = "BİR"
    sayi(2, 1) = "İKİYÜZ": sayi(2, 2) = "YİRMİ": sayi(2, 3) = "İKİ"
    sayi(3, 1) = "ÜÇYÜZ": sayi(3, 2) = "OTUZ": sayi(3, 3) = "ÜÇ"
    sayi(4, 1) = "DÖRTYÜZ": sayi(4, 2) = "KIRK": sayi(4, 3) = "DÖRT"
    sayi(5, 1) = "BEŞYÜZ": sayi(5, 2) = "ELLİ": sayi(5, 3) = "BEŞ"
    sayi(6, 1) = "ALTIYÜZ": sayi(6, 2) = "ALTMIŞ": sayi(6, 3) = "ALTI"
    sayi(7, 1) = "YEDİYÜZ": sayi(7, 2) = "YETMİŞ": sayi(7, 3) = "YEDİ"
    sayi(8, 1) = "SEKİZYÜZ": sayi(8, 2) = "SEKSEN": sayi(8, 3) = "SEKİZ"
    sayi(9, 1) = "DOKUZYÜZ": sayi(9, 2) = "DOKSAN": sayi(9, 3) = "DOKUZ"
    basamak(5) = "TRİLYON"
    basamak(4) = "MİLYAR"
    basamak(3) = "MİLYON"
    basamak(2) = "BİN"
    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

Benzer Sonuçlar
No	Makro Adı
1	rakamı yazıya çevirme makrosu
2	rakamı / sayıyı İngilizce yazıya çevirmek (Dolar ve cent para birimi şeklinde)
3	Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe)
4	sayıyı rakama kuruşlu çevirmek
5	hücredeki rakamlari harf karşiliklarina çevirme
6	userformun açılış sayısını sınırlamak (demo yapmak)
7	Inputbox ile doğru rakamı girmeye zorlama
8	hücredeki sayının son rakamını 0 (sıfır) yapar
9	textboxta rakamın başına 0 sıfır ekleme
10	textboxa girerken her üç rakamın arasına bir nokta koyma
11	sayfada rakamı bul veya yakınını bulma
12	hücre renkleri ile ilgili kodlar
13	yer tanımlama makrosu
14	excel'de kopyalama makrosu nasıl yazılır?
15	vb kodlari ile bir excel dosyası aciyorum fakat bu excel dosyasindaki makroyu çalıştırma2
16	excel sayfasında yazılanları texte çevirmek
17	sayfaya jpeg eklemek
18	Seçilen bölgedeki bütün yazıları küçük harfe çevirmek
19	Seçilen bölgedeki bütün yazıları büyük harfe çevirmek
20	önizleme makrosu

Benzer Sonuçlar

Makro Adı

rakamı yazıya çevirme makrosu

rakamı / sayıyı İngilizce yazıya çevirmek (Dolar ve cent para birimi şeklinde)

Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe)

sayıyı rakama kuruşlu çevirmek

hücredeki rakamlari harf karşiliklarina çevirme

userformun açılış sayısını sınırlamak (demo yapmak)

Inputbox ile doğru rakamı girmeye zorlama

hücredeki sayının son rakamını 0 (sıfır) yapar

textboxta rakamın başına 0 sıfır ekleme

textboxa girerken her üç rakamın arasına bir nokta koyma