Excelde sayıyı yazıyla yazdırma

Yeni sürüm

06/06/2025: Kodlar güncellendi

Github Proje Sayfası

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