PDA

Tüm Versiyonu Göster : rakamı yazıya çevirme


mustafabayraktaroglu
03-01-2005, 14:55
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
03-01-2005, 15:00
Aşağıdaki linkte ilgili kodlar mevcuttur.

selamlar

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

mustafabayraktaroglu
03-01-2005, 15:33
bu linklerden pek bir şey anlamadım
denedim olmadı nasıl yapacağız yardımcı olursanız sevinirim

Levent Menteşoğlu
03-01-2005, 15:43
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
03-01-2005, 16:00
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
03-01-2005, 16:08
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
03-01-2005, 16:22
malesef olmadı
ben size dosyayı yolluyorum

teşekkürler

Levent Menteşoğlu
03-01-2005, 16:40
Gerekli ilaveleri yaptım.

muygun
06-01-2005, 08:25
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
06-01-2005, 09:09
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
06-01-2005, 12:17
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
06-01-2005, 13:04
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
06-01-2005, 13:06
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İ
06-01-2005, 15:55
ALLAH RAZI OLSUN

servet
06-01-2005, 16:20
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
06-01-2005, 16:36
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
06-01-2005, 16:50
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
06-01-2005, 17:10
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
06-01-2005, 18:56
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ı
07-01-2005, 00:42
arkadaşlar neden virgülden sonraki basamakların sayısına dikkat etmezler?

Levent Menteşoğlu
07-01-2005, 07:57
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
13-04-2007, 12:54
ben exelde bu vermiş olduğunuz programı bütün sayfalarda kullanmak istiyorum yardımcı olurmusunuz

Levent Menteşoğlu
13-04-2007, 14:28
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
22-04-2007, 20:08
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
24-05-2007, 09:18
exzel deniyorum başarısız olmuyor

srmt5561
30-10-2007, 09:27
tşkl............................

exelansen
24-03-2008, 23:17
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
24-03-2008, 23:19
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
24-03-2008, 23:22
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
27-05-2008, 18:54
ya bu nunu nereye koyazagızda calışacak

haso_excel
24-11-2008, 13:44
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
07-10-2009, 11:00
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
29-06-2010, 18:10
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
29-06-2010, 19:14
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
29-06-2010, 19:19
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
29-06-2010, 23:25
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
30-06-2010, 09:02
ılgınızden dolayı tesekkurler arkadaslar. Sorunu cozmek uzereyım. Emeklerınız ıcın cok sagolun.