rakamı yazıya çevirme

[mustafabayraktaroglu]

merhaba

rakamı yazıya çevirme ile ilgili bir formül varmı

kuruş hesabına göre

yardımcı olursanız sevinirim

[Levent Menteşoğlu]

Aşağıdaki linkte ilgili kodlar mevcuttur.

selamlar

http://www.excel.web.tr/viewtopic.php?t=1177&highlight=kuru%FE

[mustafabayraktaroglu]

bu linklerden pek bir şey anlamadım
denedim olmadı nasıl yapacağız yardımcı olursanız sevinirim

[Levent Menteşoğlu]

Ekteki örneği inceleyiniz. Linkteki bir fonksiyon için yazılı kodlar bir module sayfasına kopyalandı. Artık fonksiyon listenizde "paracevir" isimli yeni bir fonksiyon göreceksiniz. Bu fonksiyon rakamı yazıya çevirecektir.

[mustafabayraktaroglu]

1256,89 #AD?
böyle bir hata veriyor ne yapmam gerek ayrıca ben bunu başka bir dosyaya kaydetmek istiyorum yardımcı olursanız sevinirim

teşekkürler

[Levent Menteşoğlu]

Ekte verilen dosyanın visual basic düzenleyicisine girin. Orada gördüğünüz kodları kendi dosyanıza kopyalayın. Daha sonra sayının metin karşılığını hangi hücreye yazdıracaksanız o hücreye fonksiyon ekleme bölümünden "ParaCevir" isimli fonksiyonu seçin. Aşağıdaki gibi bir fonksiyon olacaktır. Bu örnekte A1 hücresindeki sayı metne çevrilmektedir. Eğer yine olmazsa dosyanızı ekleyin onun üzerinden gidelim.

=ParaCevir(A1)

[mustafabayraktaroglu]

malesef olmadı
ben size dosyayı yolluyorum

teşekkürler

[Levent Menteşoğlu]

Gerekli ilaveleri yaptım.

[muygun]

kodları yazan arkadaş bunu "kullanıcı tanımlı fonksiyon" a dönüştürüp dosyayı buraya ekler ve nasıl kullanılacağını yazarsa sanırım birçok kişinin sorununu çözmüş olur.

[BeyazGölge]

muygun galiba örnek dosyayı incelemedin.

Çok iyi bir şekilde çalışıyor. Kullanıcı tanımlı fonksiyon halinde zaten..


Public Function ParaCevir(Para)
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"

Exit Function

SayiDegil:
ParaCevir = "GİRİLEN DEÃ�ER SAYI DEÃ�İL!"
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

[muygun]

Slm lar.

inceledim
0,356 da Sıfır Lira 356 Kuruş ,
123,0 da 123 Lira Sıfır Kuruş yazdığını da biliyorum
VB bilgim yok denecek kadar az
ama kodların virgülden önce veya sonra değer sıfır ise yazmaması gerektiğini düşünüyorum. (bu benim düşüncem belki yanlış olabilir.)
birde XLSTART klasörünün içinde kullanılacak şekilde (.XLA uzantılı) eklenti buraya ilave edilirse çok kimsenin kullanacağına eminim (ben dahil)

saygılar...

[xxrt]

Virgülden Ã?nceki değer Sıfır Yazmazsa
,356 gibi durum ortaya çıkmazmı?Yine Aynı Ã�ekilde
123, He.(,)Virgülü Kaldıralım.
123 Oluyor.Bu Seferde 123 YTL Okunma hissi doğuyor.Bana Böyle geldi.

Bu Arada Bilgi Olarak
30.09.2004/25599 Tarihli Resmi Gazetede Binlik Ayraç (.),Kuruş için (,) Konulması Kanunlaşmıştır.

Siz "Sıfır"Yazısının Çıkmasını istemiyorsunuz sanırım.Ozamanda Yaz ile İstenilen kuruş yazısı el ile yazılabilir.Ama Düşüncemde hatalıda olabilrim.Değişik Görüşlerde gelecektir.

Eklenti Dosyası Ataçta eklenmiş olup Bunun .xls olan Uzantısını .xla yapıp
C:\WINDOWS\Profiles\Muhasebe\Application Data\Microsoft\AddIns Klasörüne kopyalayız.

[Levent Menteşoğlu]

Sn muygun

Uyarınızı dikkate alarak kodda bir değişiklik yaptım. Yaptığım değişiklik aşağıdaki gibidir. Ekide incelerseniz işlevin sıfır lira ve sıfır kuruş yazmadığını göreceksiniz.

Selamlar

[vb:1:377c858028]Public Function ParaCevir(Para)
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If Lira = 0 Then
ParaCevir = Cevir(Kurus) & " Kuruş"
Exit Function
End If
If Kurus = 0 Then
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira"
Exit Function
End If
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"
Exit Function
SayiDegil:
ParaCevir = "GİRİLEN DEÃ�ER SAYI DEÃ�İL!"
End Function[/vb:1:377c858028]

[UGUR ARDAHANLİ]

ALLAH RAZI OLSUN

[servet]

slm sevgili arkadaslar benim excel de bir sorunum var
bu YTL DURUMU iyice karıştı misal vererek anlatmak istiyorum
115,58 YTL de kuruş hanesinin son rakamı olan 8 in
1 ile 4 arası ise otomotikman 0 olarak yazılması
5 ile 9 arası ise otomotikman 5 yazılması lazım bunun için bana yardımcı olabilirmisiniz

[Levent Menteşoğlu]

Aşağıdaki işlev işinizi görecektir. Burada A1 hücresindeki değere göre çalışır,siz bunu değiştirirsiniz.

=YUVARLA(A1;1)

[holifera]

Sorunuzu tam olarak anlayamadım ama TL'den YTL'ye dönüştürürken bu yuvarlamayı yapan fonksiyonu Muhasebat Genel Müdürlüğü Genel Tebliğinde yayınlamıştı. Forumda daha önce yayınlanmış olabilir.

=((A2-(SA�DAN(A2;4)))/1000000)+((E�ER(((SA�DAN(A2;4))-5000)>=0;1;0))/100)

[xxrt]

bu YTL DURUMU iyice karıştı misal vererek anlatmak istiyorum
115,58 YTL de kuruş hanesinin son rakamı olan 8 in
1 ile 4 arası ise otomotikman 0 olarak yazılması
5 ile 9 arası ise otomotikman 5 yazılması lazım

Bakın Karışıklıklar muhakkak olacaktır.Ama Genel Bir kanun var.Ve kanuna göre;
(.) ve (,) Ayraçlara Dikkat edin.Kanuna Göre Binlik Ayraç (.),Kuruş Ayracı ise (,) Olacak.
Yani 1.250,26 YTL (YalnızBinikiyüzellil Yeni Tl,Yirmi Altı Kuruş)
Ã?RNEKLER:
125.125.256.000 lira=125.125,26 Olacak..

658.356.056.000 lira=658.356,06 Olacak

125.007.000 lira=125,01 Olacak.

1.300,395 lira=1.300,40 Olacak

3,750 lira=3,75 Olacak

60,150 lira=60,15 Olacak

88,220 lira=88,22 Olacak

1.416,905 lira=1.416,91 Olacak


Hesaplamalarda Bu kurallar geçerlidir..

[muygun]

slm.lar
öncelikle çözüm üretenlere teşekkürler.
sn.leventm. uğraşın için ayrıca tşk.
ama anlaşılan problem o kadar basit değil.
çözümüne 2 şekilde gidilebiliyor.
1.si standart kod üretimi ile ne görünüyorsa bunu yazıya çevirmek (ki bence doğru olan bu)
2.si tebliğler de belirtilen yuvarlama,virgülden sonra 2 rakam alma vs. gibi konumlara göre kod üretmek
işte karmaşa burda zannedersem zamanla kullanımdaki sıkıntılar açığa çıkacak ve yeni çözümler üretilecek.

saygılar...

[sıtkı]

arkadaşlar neden virgülden sonraki basamakların sayısına dikkat etmezler?

[Levent Menteşoğlu]

Sn sıtkı

biede şu işlevi deneyiniz.

=EÃ�ER(SAYIYAÇEVİR(SAÃ�DAN(A1;1))<5;A1+(5-SAYIYAÇEVİR(SAÃ�DAN(A1;1)))/100;A1)

[cunyurmusa]

ben exelde bu vermiş olduğunuz programı bütün sayfalarda kullanmak istiyorum yardımcı olurmusunuz

[Levent Menteşoğlu]

Aradığınız uygulamayı aşağıdaki linkte bulabilirsiniz.

Sayıyı Yazıya Çevirme Uygulamaları (http://www.excel.web.tr/forumdisplay.php?f=116)

[Feramiz1970]

Arkadaşlar ofis 2003 te makro olarak kaydettiğim "Rakamı Yazıya Çevir" makrosu Ofis 2007 de hata veriyor. Bu konuda bilgisi olan varsa bir zahmet açıklarsa sevinirim.

[CİNOXX]

exzel deniyorum başarısız olmuyor

[srmt5561]

tşkl............................

[exelansen]

arkadaşlar visual basic nedir bu rakamı yazıya çevirme işlemini sanki excelle yeni başlar gibi anlatırsanız sevinirim hiç bişi anlayamadım cahilliğime verin.

[exelansen]

merhaba öncelikle çok faydalı bir forum olmuş tebrik ederim ama ben epeyce yabancıyım bu konulara rakamı yazıya çevirmek ile ilgili bir prıblemim var. önce visual basic ayarlarından falan bahsedildi anlayamadım herkes aşinası olduğu konuları anlatmış ben anlayamadım nasıl yapabilirim yardımcı olurmusun?

[Levent Menteşoğlu]

Aşağıdaki linkte yazıya çevirme eklentisinin nasıl yapılacağı izah edilmiştir, incelemenizi öneririm.

[/URL] [URL="http://www.excel.web.tr/showthread.php?t=12077"]Sayıyı Yazıya Çevirme ve YTL-YKR Uygulaması (eklenti) (http://www.excel.web.tr/forumdisplay.php?f=116#)

[xoanaconda]

ya bu nunu nereye koyazagızda calışacak

[haso_excel]

Merhaba arkadaşlar,

Yukarıdaki makroyu aldım. A1 hücresindeki bir rakamı A2 hücresine yazı olarak nasıl yazarım yardımcı olurmusunuz lütfen

[Tito78]

Sn muygun

Uyarınızı dikkate alarak kodda bir değişiklik yaptım. Yaptığım değişiklik aşağıdaki gibidir. Ekide incelerseniz işlevin sıfır lira ve sıfır kuruş yazmadığını göreceksiniz.

Selamlar

[vb:1:377c858028]Public Function ParaCevir(Para)
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If Lira = 0 Then
ParaCevir = Cevir(Kurus) & " Kuruş"
Exit Function
End If
If Kurus = 0 Then
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira"
Exit Function
End If
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"
Exit Function
SayiDegil:
ParaCevir = "GİRİLEN DEÃ�ER SAYI DEÃ�İL!"
End Function[/vb:1:377c858028]

Sn. Menteşoğlu "rakamı sayıya çevirmek" konusunda bence en başarılı formül sizin yukarıda yazmış olduğunu formüldür, kuşkusuz. Çok teşekkürler. Fakat şöyle küçük bir sorun yaşadım formül excel 2003 te sorunsuz çalışmakta lakin excel 2007 de hata vermektedir. Acaba ben mi beceremedim yoksa gerçekten formül excel 2007 de çalışmamaktamıdır? ilgi ve alakanıza şimdiden çok teşekkürler. Selamlar...

[aLoneR]

Arkadaslar benim pc de daha once Office 2003 kurulu idi.. sonra begenmedim ve office XP yukledim. Office surumunu degistirdikten sonra Paracevir fonksiyonu calismaz oldu.. eski *.xla dosyam duruyor. Ben bunu c:\windows un altina atarak calistirmistim. simdi yine eski yerinde ama calismiyor. #AD? seklinde hata veriyor.

[mustafakoker]

sayın aLoneR aşağıdaki kodu vba da yeni bir module ekleyin çalışacaktır
Kodlar daha önceden bu siteden alıntıdır.bende sorunsuz çalışmaktadır.

kodu kaydettikten sonra formül =paracevir(C26;"TL";"KRŞ")

Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruş")
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

[aLoneR]

Mustafa Bey ilginizden dolayi cok tesekkur ederim. Sanirim benim sorunum kodlarla degil.
soyle ki.. benim sistemimde kurulu olan office de sanirim cok ileri duzeyde guvenlik engeli var ve makrolarin calismasina musaade etmiyor. su ana kadar bunu cozebildim. *.xla uzantili dosyayi manuel olarak bir defa calistirinca butun excel sayfalarinda sorunsuz calisiyor. Fakat excel uygulamasindan tamamen cikip yeniden sadece excel acmaya kalkinca baglanti guncellemesi soruyor. eskiden sormuyordu. baglantilari guncelle deyince de makronun yerini bulamiyor ve yine hata veriyor.

[s.savas]

Mustafa Bey ilginizden dolayi cok tesekkur ederim. Sanirim benim sorunum kodlarla degil.
soyle ki.. benim sistemimde kurulu olan office de sanirim cok ileri duzeyde guvenlik engeli var ve makrolarin calismasina musaade etmiyor. su ana kadar bunu cozebildim. *.xla uzantili dosyayi manuel olarak bir defa calistirinca butun excel sayfalarinda sorunsuz calisiyor. Fakat excel uygulamasindan tamamen cikip yeniden sadece excel acmaya kalkinca baglanti guncellemesi soruyor. eskiden sormuyordu. baglantilari guncelle deyince de makronun yerini bulamiyor ve yine hata veriyor.

Dostum *.xla türü eklenti ile rakamı yazıya çevrilen dosyalar kopyalanınca veya her hangi bir makinada hazırladığın kitabı farklı bir makinada açınca da aynı hatayı veriyor. Bunun çözümü rakamı yazıya çeviren formülün bulunduğu hücrelerdeki formülleri yenilemen gerekiyor.
Yada excelin genelinde bu uygulamayı çalıştırmak istemezsen eğer aşağıdaki kodu yeni bir modül içerisine yapıştırman yeterli olur.
Bu uygulama sadece modülün eklendiği kitapta çalışır, başka uygulamalarda da kullanmak istersen aynı modülü diğer kitaplarına da kopyalaman gerekir.
Kodlar forumdan alıntıdır.
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

Function yaz$(sayi)


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 hata1

Next x



If Len(a$) > 15 Then GoTo hata1

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$

GoTo tamam1

hata1: s$ = "Hata1"

tamam1:

''''''''''''


a$ = Str(CInt((sayi * 100) - Int(sayi) * 100))



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 hata2



Next x



If Len(a$) > 15 Then GoTo hata2

a$ = String(15 - Len(a$), "0") + a$



For x = 1 To 15

v(x) = Val(Mid$(a$, x, 1))

Next x



kr$ = ""

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"

kr$ = kr$ + e$

Next x



If kr$ = "" Then kr$ = "Sıfır"

If pozitif = 0 Then kr$ = "Eksi" + kr$


'''''''''''

GoTo tamam2

hata2: kr$ = "Hata2"

tamam2:

If s$ = "Sıfır" And kr$ <> "Sıfır" Then yaz$ = kr$ + "-KR"
If s$ <> "Sıfır" And kr$ = "Sıfır" Then yaz$ = s$ + "-TL "
If s$ = "Sıfır" And kr$ = "Sıfır" Then yaz$ = ""
If s$ <> "Sıfır" And kr$ <> "Sıfır" Then yaz$ = s$ + "-TL " + kr$ + "-KR"

End Function

[aLoneR]

ılgınızden dolayı tesekkurler arkadaslar. Sorunu cozmek uzereyım. Emeklerınız ıcın cok sagolun.