Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe) 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 Sayıyı_Yazıya_Çevir(Tutar As Currency) As String
Dim Tutar_Standart As String
Dim Nokta_Sayısı As Byte
Dim Noktanın_Yeri() As Byte
Dim i As Byte
Dim j As Byte
Dim Virgülden_Önce
Dim Virgülden_Sonra
Dim Noktadan_Önce
Dim Büyük_Değer(1 To 6) As String
Tutar_Standart = Format(Tutar, "#,0")
Büyük_Değer(1) = ""
Büyük_Değer(2) = " bin "
Büyük_Değer(3) = " milyon "
Büyük_Değer(4) = " milyar "
Büyük_Değer(5) = " trilyon "
Büyük_Değer(6) = " katrilyon "

'Virgülden_Sonra = Right(Tutar_Standart, 3)
'If Virgülden_Sonra = ",00" Then Virgülden_Sonra = "0"
Virgülden_Önce = Tutar_Standart ' Left(Tutar_Standart, Len(Tutar_Standart) - 3)
Noktadan_Önce = Len(Virgülden_Önce) Mod 4
Select Case Len(Virgülden_Önce)
Case 1 To 3
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Virgülden_Önce)
Case 5 To 7
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Len(Virgülden_Önce) - 4)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Right(Virgülden_Önce, 3))
Case 9 To 11
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3))
Case 13 To 15
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3))
Case 17 To 19
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 14, 3))
Case 21 To 23
Sayıyı_Yazıya_Çevir = Üç_Basamaklı_Yazı(Left(Virgülden_Önce, Noktadan_Önce)) & Büyük_Değer(6) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(3) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 14, 3)) & Büyük_Değer(6) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 2, 3)) & Büyük_Değer(5) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 6, 3)) & Büyük_Değer(4) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 10, 3)) & Büyük_Değer(2) & Üç_Basamaklı_Yazı(Mid(Virgülden_Önce, Noktadan_Önce + 18, 3))
End Select
Sayıyı_Yazıya_Çevir = Sayıyı_Yazıya_Çevir ' & " lira " & Üç_Basamaklı_Yazı(Right(Virgülden_Sonra, 2)) & " Kuruş"
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Proper(Sayıyı_Yazıya_Çevir)
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Trim(Sayıyı_Yazıya_Çevir)
If Left(Sayıyı_Yazıya_Çevir, 7) = "Bir Bin" Then
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Bir Bin", "Bin")

End If
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Sıfır Lira", "Lira")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Milyon Sıfır Bin", "Milyon")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Lira", "Nokta")
Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, "Kuruş", "")
'If Right(Tutar_Standart, 2) = "00" Then
'Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, " Nokta Sıfır ", "")
'Sayıyı_Yazıya_Çevir = Left(Sayıyı_Yazıya_Çevir, Len(Sayıyı_Yazıya_Çevir) - 1)

'End If
'Sayıyı_Yazıya_Çevir = Sondan_İkinci_Boşluk_Bul(Sayıyı_Yazıya_Çevir)
'If IsNumeric(Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find(" ", Sayıyı_Yazıya_Çevir, Application.WorksheetFunction.Find("Nokta", Sayıyı_Yazıya_Çevir) + 1) + 1) + 1)) = False Then

'Sayıyı_Yazıya_Çevir = Application.WorksheetFunction.Substitute(Sayıyı_Yazıya_Çevir, " Nokta", "Nokta Sıfır")

'End If
End Function
Function Üç_Basamaklı_Yazı(Sayı)
Dim Uzunluk As Byte
Sayı = Int(Sayı)
Sayı = CStr(Sayı)
Uzunluk = Len(Sayı)
If Sayı = 0 Then
Üç_Basamaklı_Yazı = "sıfır"
Exit Function
End If
Select Case Uzunluk
Case 1
Üç_Basamaklı_Yazı = Choose(Sayı, "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Case 2
a = Choose(Mid(Sayı, 1, 1), "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
If Mid(Sayı, 2, 1) = 0 Then
b = ""
Else
b = Choose(Mid(Sayı, 2, 1), "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
End If
Üç_Basamaklı_Yazı = a & " " & b
Case 3
a = Choose(Mid(Sayı, 1, 1), "", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz") & " yüz"
If Mid(Sayı, 2, 1) = 0 Then
b = ""
Else
b = Choose(Mid(Sayı, 2, 1), "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
End If
If Mid(Sayı, 3, 1) = 0 Then
c = ""
Else
c = Choose(Mid(Sayı, 3, 1), "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
End If
Üç_Basamaklı_Yazı = a & " " & b & " " & c
End Select
End Function
Function Sondan_İkinci_Boşluk_Bul(İfade)
Dim Nokta_Yeri As Integer
Dim Adet As Byte
Nokta_Yeri = Application.WorksheetFunction.Find("Nokta", İfade)
For i = Len(İfade) To Nokta_Yeri Step -1
If Mid(İfade, i, 1) = " " Then
Adet = Adet + 1
End If
Next i
If Adet

No	Makro Adı
1	Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe)
2	rakamı / sayıyı İngilizce yazıya çevirmek (Dolar ve cent para birimi şeklinde)
3	rakamı yazıya çevirme makrosu
4	sayıyı rakama kuruşlu çevirmek
5	hücredeki sayıyı alt veya üst karaktere ve normale çevirir. h2o, co2
6	excelde kendi eklenti ve fonksiyonlarınızı oluşturun
7	sayının karekökü
8	sayfada renklendirilmesini istediğiniz sayıyı msgboxa yazınız
9	formülleri sayıya çevirme
10	kırmızı renkli sayıyı seç g12 ye yazsın
11	sayıyı paranteze alma örnek: 3- = (3) sayının yanına çizgi şart
12	sayıyı dolar olarak okuma =dollartext(a1)
13	sayıyı dakika ve saniye cinsinden yazma
14	hücredeki sayıyı bulma
15	hücredeki rakamlari harf karşiliklarina çevirme
16	verilen sayıyı gruplara bölme işlemi
17	userformun açılış sayısını sınırlamak (demo yapmak)
18	Hücrelerde geçen en büyük sayıyı bulma / Bir alanda en büyük sayı hangisi
19	otomatik makro her 10 saniyede
20	makroları otomatik açılması, çalışması, kapanması

Excel Hazır Makrolar (VBA)

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

Robotik Kodlama

Hizmetler

Size nasıl yardımcı olabiliriz?

Youtube Kanalımıza Abone Oldunuz mu?

Anahtar Kelimeler