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ı
VBA kodlarını görmek için dosyayı açtıktan sonra ALT+F11'e basın.
İndir YAZIYLA.XLS 130 Kb
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.
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
' https://www.mesutakcan.blogspot.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
