• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Toplam tutarı yazı cinsine çevirme

Katılım
31 Ağustos 2011
Mesajlar
151
Excel Vers. ve Dili
Office Professional Plus 2021- Türkçe
Arkadaşlar kolay gelsin,

Bir excel dosyasında toplam mali değeri yazı cinsine çevirebilmenin bir yolu var mıdır ?

Şöyle ki bir toplama işleminin sonucundan elde edilen veriyi başka bir hücrede yazı cinsinden yazmamız gerekiyor.

Toplam değeri misalen, 3.000 TL olduğunu varsayarsak ilgili hücreye "Üç Bin Türk Lirası" yazdırabilecek bir formül yada makro varsa, yardımcı olabilir misiniz ?
 
Burada Levent Bey'in hazırladığı dosyayı kendi bilgisayarınızda Excel Eklentiler klasörüne ekleyin. Daha sonra excel açıkken boş bir yere sağ tıklayın. Açılan popup penceresinde parametre ayarını açın ve YTL-YKR olanları TL-KR olarak değiştirin.
Eklenti yükleme ve ayarlama bittikten sonra; Örneğin, yazıyla yazmak istediğiniz sayı A1 hücresinde ise başka bir hücreye şu formülü yazın; =yaziyla(A1)
 
Arkadaşlar kolay gelsin,

Bir excel dosyasında toplam mali değeri yazı cinsine çevirebilmenin bir yolu var mıdır ?

Şöyle ki bir toplama işleminin sonucundan elde edilen veriyi başka bir hücrede yazı cinsinden yazmamız gerekiyor.

Toplam değeri misalen, 3.000 TL olduğunu varsayarsak ilgili hücreye "Üç Bin Türk Lirası" yazdırabilecek bir formül yada makro varsa, yardımcı olabilir misiniz ?
Levent beyden alıntı.
Kod:
Function yaziyla(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
b = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
c = Array("", "", "bin", "milyon", "milyar", "trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "yüz", "biryüz", "yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "birbin" Then son = Replace(son, "birbin", "bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then ytl = son & " YTL"
If g = 2 And deger(2) <> 0 Then ykr = " " & son & " YKR"
son = ""
e = 0
Next
yaziyla = ytl & ykr
End Function

Ekteki dosyayı inceleyin.
 

Ekli dosyalar

Geri
Üst