Yeni sürüm
06/06/2025: Kodlar güncellendi
Option Explicit
Function YAZIYLA(sayi As Variant) As String
' Sayıyı yazıyla yazar
'
' Mesut Akcan
' https://www.mesutakcan.blogspot.com
' makcan@gmail.com
'
' 23 Nisan 2004
' Güncelleme: 5 Haziran 2025
Dim birler(9) As String, onlar(9) As String, buyukSayi(4) As String
Dim basamak(1 To 15) As Byte, grup(1 To 3) As Byte
Dim sayiMetni As String, grupMetni As String
Dim sonuc As String
Dim negatif As Boolean
Dim i As Byte, j As Byte 'index
If (Not IsNumeric(sayi)) Or (Len(sayi) > 15) Then ' Sayı değilse veya 15 basamaktan büyükse hata
YAZIYLA = "#HATA!"
Exit Function
End If
If sayi < 0 Then
negatif = True 'Sayı negatif
sayi = Abs(sayi)
End If
' Birler basamağı
birler(0) = ""
birler(1) = "Bir"
birler(2) = "İki"
birler(3) = "Üç"
birler(4) = "Dört"
birler(5) = "Beş"
birler(6) = "Altı"
birler(7) = "Yedi"
birler(8) = "Sekiz"
birler(9) = "Dokuz"
' Onlar basamağı
onlar(0) = ""
onlar(1) = "On"
onlar(2) = "Yirmi"
onlar(3) = "Otuz"
onlar(4) = "Kırk"
onlar(5) = "Elli"
onlar(6) = "Altmış"
onlar(7) = "Yetmiş"
onlar(8) = "Seksen"
onlar(9) = "Doksan"
' Büyük sayılar
buyukSayi(0) = "Trilyon "
buyukSayi(1) = "Milyar "
buyukSayi(2) = "Milyon "
buyukSayi(3) = "Bin "
buyukSayi(4) = ""
sayiMetni = Right(String(15, "0") & CStr(Fix(sayi)), 15) ' Sayıyı metne çevir ve boşlukları kaldır
' 1'den 15'e kadar döngü
' karakterleri tek tek al ve sayıya çevir ve diziye aktar
For i = 1 To 15
basamak(i) = CByte(Mid(sayiMetni, i, 1))
Next
sonuc = "" ' Sonuç metni
' sayı metnini 3'erli 5 gruba ayır ve her grubu yazıya çevir
For i = 0 To 4
For j = 1 To 3 'gruptaki yüzler, onlar, birler basamakları
grup(j) = basamak((i * 3) + j)
Next
Select Case grup(1) ' Yüzler basamağı
Case 0 ' sıfır ise
grupMetni = "" ' Yüzler basamağı metni boş
Case 1 ' 1 ise
grupMetni = "Yüz" ' Yüzler basamağı metni "Yüz"
Case Else ' 2-9 arası ise
grupMetni = birler(grup(1)) & "Yüz" ' Yüzler basamağı metni "İkiYüz", "ÜçYüz" vb.
End Select
grupMetni = grupMetni & onlar(grup(2)) & birler(grup(3)) ' Onlar ve birler basamağını ekle
If grupMetni <> "" Then
grupMetni = grupMetni & buyukSayi(i) ' Büyük sayıları ekle
If (i = 3) And (grupMetni = "BirBin ") Then
grupMetni = "Bin" ' "BirBin" durumunu düzelt
End If
End If
sonuc = sonuc & grupMetni ' Sonucu birleştir
Next
sonuc = Trim(sonuc)
If sonuc = "" Then
sonuc = "Sıfır"
ElseIf negatif Then
sonuc = "Eksi " & sonuc
End If
YAZIYLA = sonuc
End Function
YAZIYLA fonksiyonunu kullanma
- Kodları kopyalayın.
- Excelde dosya açıkken ALT+F11 tuşlarına basın (yada Şerit menüden Geliştirici / Visual Basic tıklayın)
- VBA Editöründe menüden Insert / Module tıklayın.
- Menüden Edit / Paste ile ya da Ctrl+V ile kopyalanan kodları yapıştırın.
- Artık YAZIYLA fonksiyonunu diğer Excel fonksiyonları gibi hücrelerde kullanabilirsiniz.
Eski sürüm
Excelde sayıyı yazıyla yazdırmak için gerekli fonksiyonu oluşturan VBA
kodları
Kodlar aşağıdaki excel dosya içinde de mevcuttur.
VBA kodlarını görmek için dosyayı açtıktan
sonra
ALT+F11'e basın.
İndir
YAZIYLA.XLS 130 Kb
YAZIYLA fonksiyonunu tüm excel dosyalarında kullanma
Bu işlemler bir defa yapılacaktır.
yaziyla.xls dosyasını açın.
Oku1, Oku2 ve Test sayfalarını silin (Sayfaya geçin
Düzen/Sayfayı sil)
Dosya / Farklı kaydet'i tıklayın
Kayıt Türü
listesinden "Microsoft Office Excel Eklentisi (*.xla)" seçin
Kayıt Yeri
'nde "Addins" belirir.
Kaydet'i tıklayın
Dosyayı kapatın
Yeni
bir excel dosyası ya da varolan bir excel dosyanızı açın
Araçlar /
Eklentiler' i tıklayın
Burada "Kullanılabilir eklentiler"de "Yazıyla"
göreceksiniz. Yanındaki kareyi tıklayıp seçin.
Tamam'ı tıklayın.
Artık
her excel dosyasında YAZIYLA fonksiyonunu başka bir işlem yapmadan rahatlıkla
kullanabilirsiniz.
Option Explicit
Function YAZIYLA(sayi As Variant) As String
' Sayıyı yazıyla yazar
' Mesut Akcan
' Anamur Endüstri Meslek Lisesi
' Metal Teknolojisi Öğretmeni
' mesutakcan.blogsppot.com
' makcan@gmail.com
'
' 23 Nisan 2004
' Güncelleme: 31 Mart 2011
Dim b(9) As String, y(9) As String, m(4) As String, a As String
Dim v(15), c(3)
Dim pozitif As Byte, x As Byte
Dim s As String, e As String
b(0) = ""
b(1) = "Bir"
b(2) = "İki"
b(3) = "Üç"
b(4) = "Dört"
b(5) = "Beş"
b(6) = "Altı"
b(7) = "Yedi"
b(8) = "Sekiz"
b(9) = "Dokuz"
y(0) = ""
y(1) = "On"
y(2) = "Yirmi"
y(3) = "Otuz"
y(4) = "Kırk"
y(5) = "Elli"
y(6) = "Altmış"
y(7) = "Yetmiş"
y(8) = "Seksen"
y(9) = "Doksan"
m(0) = "Trilyon "
m(1) = "Milyar "
m(2) = "Milyon "
m(3) = "Bin "
m(4) = ""
a = Str(Int(sayi))
If Left$(a, 1) = " " Then pozitif = 1 Else pozitif = 0
a = Right$(a, Len(a) - 1)
For x = 1 To Len(a)
If (Asc(Mid$(a, x, 1)) > Asc("9")) Or (Asc(Mid$(a, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a) > 15 Then GoTo hata
a = String(15 - Len(a), "0") + a
For x = 1 To 15
v(x) = Val(Mid$(a, x, 1))
Next x
s = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "Yüz"
Else
e = b(c(1)) + "Yüz"
End If
e = e + y(c(2)) + b(c(3))
If e <> "" Then e = e + m(x)
If (x = 3) And (e = "BirBin ") Then e = "Bin"
s = s + e
Next x
If s = "" Then s = "Sıfır"
If pozitif = 0 Then s = "Eksi " + s
YAZIYLA = s
GoTo tamam
hata:
YAZIYLA = "Hata"
tamam:
End Function
