rakamı yazıya çevirmek

[TRABLUS]

merhaba ben sitenize yeni üye oldum excel kullanıcıları için çok güzel bir site hazırlamışsınız yardımlarınız için şimdiden teşekkür ederim soruma gelince herhangi bir hücrede bulunan rakam cinsinden yazıyı harfe nasıl çevirebilirim yani 2.000.000 tl yazı ile iki milyon lira nasıl yazdırabilirim

[Haluk]

http://www.excel.web.tr/viewtopic.php?t=366


http://www.excel.web.tr/viewtopic.php?t=171&highlight=ytl

ve ayrıca;

office.gen.tr sitesine bakabilirsiniz.

[mars2]

Aşağıdaki kodu module kaydet, istediğin hücreye =yaz(sayi) formülünu yazdıktan sonra rakamı yazıya çevirir.


Function yaz$(sayi)

Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

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(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$

yaz$ = s$
GoTo tamam
hata: yaz$ = "Hata"
tamam:
End Function

Edit:Kod görünümü olarak düzeltildi.

[htsumer]

Merhaba,Mars2 arkadaşımızın kodunu yeni Kuruş Tl ile arşivinize alırsanız eminim işinize yarıyacaktır.Bir Modul1'in içine 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 FunctionKodlarınızı ilave ettikten sonra =ParaCevir(A1)Fonksiyonunu herhangi bir hücreye yazdıktan sonra A1 Hücresine Mesela;1,256,630 lira yaz.Sonuç:Birmilyonikiyüzellialtıbinaltıyüzotuz Lira Sıfır KuruşOlacaktır.Dahada ilerletebilirsin.

[alpersen]

teşekkürler.. ancak genede hata #NAME? vermekte...

[Haluk]

Eğer, =ParaÇevir(A1) gibi fonksiyonun ismini yanlış yazdıysan böyle bir hata alabilirsin.

Edit:
Bir de, yukarıdaki kodu eğer yeni bir module değil de sayfa modulüne yazdıysan, yine aynı hatayı alırsın.

[gokzel]

Merhaba,Mars2 arkadaşımızın kodunu yeni Kuruş Tl ile arşivinize alırsanız eminim işinize yarıyacaktır.Bir Modul1'in içine 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 FunctionKodlarınızı ilave ettikten sonra =ParaCevir(A1)Fonksiyonunu herhangi bir hücreye yazdıktan sonra A1 Hücresine Mesela;1,256,630 lira yaz.Sonuç:Birmilyonikiyüzellialtıbinaltıyüzotuz Lira Sıfır KuruşOlacaktır.Dahada ilerletebilirsin.

ARKADA�LAR BUNU NASIL YAPICAM
MODÜL 1 İ NASIL AÇIP KOPYALICAM,PEK BİLGİM YOK AMA BU BANA ÇOK LAZIM..
BİRAZ YARDIMCI OLABİLİRMİSİNİZ
Ã�İMDİDEN TEÃ�EKKÜRLER

[Levent Menteşoğlu]

Aşağıdaki linkte bizlerin hazırlamış olduğu YTL programı mevcuttur. Bu programı pc nize yükleyip,eklenti olarak kaydederseniz,sorununuzu kolaylıkla çözebilirsiniz. Çünkü bu program Yazıya çevirme fonksiyonuda içermektedir.

Not:Dosyayı indirdiğinizde Yardım menüsünün yanında YTL menüsü olarak göreceksiniz.

http://www.excel.web.tr/viewtopic.php?t=2236

[gokzel]

BA�ARDIM ARKADA�LAR
İSTEYİNCE OLUYORMUÃ� DEMEKKİ
YARDIMLARINIZ İÇİN
HEPİNİZE ÇOK TEÃ�EKKÜRLER :hihoho:

[aksoy9801]

olmuyo olmuyo..modül ne bilmiyom?verdiğiniz linkler açılmıyo?..herkes yapabiliyo, ben yapamıyom..

[aksoy9801]

aloooooooooooooooo

[Seceren]

Alt+F11 basınız, sonra resimlerde modül nasıl yapılır(bulunur.....) anlatılıyor.
Daha sonra diğer anlatımları yapınız.

[gokaytasci]

Modüle dediğin yer neresi biraz daha açar mısın?benim gibi bilmeyenler olabilir diye düşündüm.Selamlar..

[gokaytasci]

Kusura bakmayın arkadaşlar cahillik ettim modülü sordum kafam başka yerlerdeydi galiba Modülü biliyorum sakın bana cevap yazmayın bu konuda:)) Yalnız rakamı yazıya çevirdikte ben metni büyük harf olsun istiyorum içinden değiştirdim ama olmadı yardımcı olur musunuz?

[Necdet Yeşertener]

Merhaba

Formülünüzün başına =BÜYÜKHARF(PARACEVIR(A1))

gibi kullanmalısınız

[xcoll]

arakadaslar ben daha önce örneğin 12.000 YTL yazıyordum baska bi satırada onikibin YTL diye yazıyordu otomatikmen yanı ytl yazıya cevırebılıyordum şimdi TL olması gerekıyor bunu nasıl yapacagım

[sezarsalatasi]

benimde bu konuda bir sorum var bilgisayarımda kullanıcı tanımlı paracevir fonksiyonu tanımlı . ve rakamı otomatikman ytl ve ykr li metne dönüştürüyor . nasıl tl ve kuruş a döndüreceğiz