rakamı yazıya çevirmek

TRABLUS · 6 Eylül 2004

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 · 6 Eylül 2004

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 · 7 Eylül 2004

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

Kod:

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 · 7 Eylül 2004

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

Kod:

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

Kodlarınızı ilave ettikten sonra

Kod:

=ParaCevir(A1)

Fonksiyonunu herhangi bir hücreye yazdıktan sonra A1 Hücresine Mesela;1,256,630 lira yaz.Sonuç:

Kod:

Birmilyonikiyüzellialtıbinaltıyüzotuz Lira Sıfır Kuruş

Olacaktır.Dahada ilerletebilirsin.

alpersen · 18 Kasım 2004

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

Haluk · 18 Kasım 2004

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 · 26 Nisan 2005

htsumer' Alıntı:

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

Kod:

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

Kodlarınızı ilave ettikten sonra

Kod:

=ParaCevir(A1)

Fonksiyonunu herhangi bir hücreye yazdıktan sonra A1 Hücresine Mesela;1,256,630 lira yaz.Sonuç:

Kod:

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 · 26 Nisan 2005

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

osyayı 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 · 26 Nisan 2005

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

aksoy9801 · 27 Nisan 2007

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

aksoy9801 · 27 Nisan 2007

aloooooooooooooooo

Seceren · 27 Nisan 2007

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 · 27 Temmuz 2007

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

gokaytasci · 27 Temmuz 2007

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 · 27 Temmuz 2007

Merhaba

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

gibi kullanmalısınız

xcoll · 7 Ocak 2009

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 · 7 Ocak 2009

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

gezerr · 26 Aralık 2012

Merhabalar, burada yeniyim ama yardımcı olabileceğinizi düşünüyorum. Elimde sayıyı yazıya çeviren kod var ama 1234 sayısını bir bin olarak yazıyor onu çözemedim. Yardımcı olabilirseniz sevinirim.

Sub dene()
Dim MyNumber
MyNumber = SpellNumber(1250)
End Sub

'Main Function
Function SpellNumber(ByVal MyNumber)
Dim TL, Kurus, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Bin "
Place(3) = " Milyon "
Place(4) = " Milyar"
Place(5) = " Trilyon "

MyNumber = Trim(Str(MyNumber))

DecimalPlace = InStr(MyNumber, ".")

If DecimalPlace > 0 Then
Kurus = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then TL = Temp & Place(Count) & TL
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case TL
Case ""
TL = "Sıfır TL"
Case "Bir"
TL = "Bir TL"
Case Else
TL = TL & " TL"
End Select
Select Case Kurus
Case ""
Kurus = " ve sifir Kurus"
Case "Bir"
Kurus = " ve Bir Kurus"
Case Else
Kurus = " ve " & Kurus & " Kurus"
End Select
SpellNumber = TL & Kurus
End Function

Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

If Mid(MyNumber, 1, 1) = "1" Then
Result = " Yüz "
ElseIf Mid(MyNumber, 1, 1) > "1" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz "
End If

If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))

Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

Function GetTens(TensText)
Dim Result As String
Result = ""
If Val(Left(TensText, 1)) = 1 Then
Select Case Val(TensText)
Case 10: Result = "On"
Case 11: Result = "Onbir"
Case 12: Result = "Oniki"
Case 13: Result = "Onüç"
Case 14: Result = "Ondört"
Case 15: Result = "Onbes"
Case 16: Result = "Onalti"
Case 17: Result = "Onyedi"
Case 18: Result = "Onsekiz"
Case 19: Result = "Ondokuz"
Case Else
End Select
Else
Select Case Val(Left(TensText, 1))
Case 2: Result = "Yirmi "
Case 3: Result = "Otuz "
Case 4: Result = "Kirk "
Case 5: Result = "Elli"
Case 6: Result = "Altmis"
Case 7: Result = "Yetmis "
Case 8: Result = "Seksen "
Case 9: Result = "Doksan "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1))
End If
GetTens = Result
End Function

Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Bir"
Case 2: GetDigit = "Iki"
Case 3: GetDigit = "Üç"
Case 4: GetDigit = "Dört"
Case 5: GetDigit = "Bes"
Case 6: GetDigit = "Alti"
Case 7: GetDigit = "Yedi"
Case 8: GetDigit = "Sekiz"
Case 9: GetDigit = "Dokuz"
Case Else: GetDigit = ""
End Select
End Function

cemorhun · 2 Şubat 2017

Merhabalar,

Formülün kullanışında küçük değişiklik yapmaya çalıştım ama olmadı.
Yapmaya çalıştığım değişiklik (Sıfır Kuruş) yazmaması yardımcı olabilirmisiniz.
Kuruşlu veri varsa yazsın, yoksa yazmasın.

123.456,78 TL
Yüzyirmiüçbindörtyüzellialtı Lira Yetmişsekiz Kuruş

123.456,00 TL
Yüzyirmiüçbindörtyüzellialtı Lira Sıfır Kuruş

rakamı yazıya çevirmek

TRABLUS

Misafir

Haluk

Özel Üye

mars2

htsumer

Altın Üye

alpersen

Haluk

Özel Üye

gokzel

Levent Menteşoğlu

Administrator

gokzel

aksoy9801

aksoy9801

Seceren

gokaytasci

gokaytasci

Necdet

Moderatör

xcoll

sezarsalatasi

gezerr

cemorhun