Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Access Soruları (http://www.excel.web.tr/forumdisplay.php?f=57)
-   -   Rakamı Yazıya Çevirme (http://www.excel.web.tr/showthread.php?t=20109)

onlyforyou 16-09-2006 11:04

Rakamı Yazıya Çevirme
 
Merhaba Arkadaşlar Alanda 75 YTL olarak görülen değeri
Yetmişbeş YTL olarak yazdırabileceğim bir fonksiyon yada bir vba yazılımı var mı teşekkürler ,

necati kose 16-09-2006 11:21

Yaziya Çevİrme
 
1 Eklenti(ler)
ARKADAŞIM EKTEKİ DOSYAYI KAYDET SONRADA İÇİNDEKİ EXCEL DOSYASINI BİRYERE KOPYALA SONRA ARAÇLAR +EKLENTİLER + GÖZAT KOPYALADIĞIN EXCELL DOSYASINI BUL VE SEÇ TAMAM DİYEREK ÇIK

SONRA YAZDIRILMASINI (NEREYE YAZDIRACAKSAN) SEÇ EKLE SEÇENEĞİNDEN İŞLEV İ SEÇ ORDA FONKSİYON EKLE SEÇENEĞİ ÇIKACAK ORDAN TÜMÜNÜ SEÇEREK YAZİYAÇEVİRYTL SEÇENEĞİNİ BUL VE SEÇ SONRA RAKAMIN YAZDIĞI HÜCREYİ SEÇ VE ENTER BU KADAAAARRR...

İYİ ÇALIŞMKALAR.
necati.kose@hotmail.com

necati kose 16-09-2006 11:25

özür
 
ben excell zannettim kusura bakmayın bunlar excel için geçerli

modalı 16-09-2006 11:57

1 Eklenti(ler)
Sayın onlyforyou,

Sonuç da fonksiyon kullanılıyor.

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

İyi çalışmalar:)

onlyforyou 16-09-2006 13:45

YTL çevirme
 
Teşekkürler modalı ;
verdiğin fonksiyon işe yaradı oldukça yararlı oldu

czeki 13-05-2008 11:02

çok teşekkürler

assenucler 14-05-2008 07:49

Teşekkür, sayın Modalı...

alievren 10-03-2009 15:41

teşekkürler ellerinize emeğinize sağlık. çok sağolunuz.

sqrm 01-01-2010 16:56

1 Eklenti(ler)
bu fonksiyon neden bende ad hatası veriyor olabilir

modalı 01-01-2010 20:00

Sayın sqrm,

Gerçi sorunuzu yanlış yere sordunuz. Excel bölümünde olmalıydı.
Aşağıdaki fonksiyonu kullanın. Değiştirince düzeldi.

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



Saat 16:01

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.