Converting Number / Number to Text Function (Turkish) Free Excel Macros (VBA) | Excel Programs

Copy Macro

'For online Excel courses click: https://www.excelsizeyeter.com/excelwithkenan.com/udemy_giris.php 
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	Macro Name
1	Converting Number / Number to Text Function (Turkish)
2	translate the number / number into English (in dollars and cents)
3	excel operators hk
4	convert numbers in cells to letters
5	Calculate Cube Root: You can use this code to calculate the cube root without applying a formula. Checks all selected cells and converts numbers to cube roots.
6	Convert Roman Numbers to Arabic Numbers: Sometimes it is really hard to understand Roman numbers as serial numbers. This code will help you convert roman numbers to Arabic numbers.
7	Convert Small Case: This code helps you convert selected text to lower case text. & Nbsp; Select a range of cells that contain your text and run this code. If a cell has any value other than a number or text, the value will remain the same.
8	sweep
9	read the number in dollars = dollartext (a1)
10	Square Root Calculator: You can use this code to calculate the square root without applying a formula. checks all selected cells and converts numbers to square.
11	Converting column letters to column numbers
12	Inputbox add year as summer
13	inserts months as sheet / pages Specifies days in detail
14	Number / Highlight Cells that Error in the entire worksheet: This code will help you to highlight and count all the cells you have made an error with. Just run this code and it will return a message containing the number error cells and will highlight all the cells.
15	collects selected fields in status bar
16	numbering
17	summer adds months to sheet / pages
18	sort data by name order
19	sort data by name order
20	Finding the largest number in cells / Which is the largest number in a field

Excel Free Macros (VBA)

Converting Number / Number To Text Function (turkish)

Online Excel Courses

Services

How can we help you?

Subscribe to our Youtube Channel?

Keywords