rakamı yazıya çevirmek

T

TRABLUS

Misafir
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
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
570
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
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

Altın Üye
Altın Üye
Katılım
7 Eylül 2004
Mesajlar
953
Excel Vers. ve Dili
Excel-2003
Altın Üyelik Bitiş Tarihi
16.08.2026
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.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,398
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
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.
 
Katılım
26 Nisan 2005
Mesajlar
2
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

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,060
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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
 
Katılım
26 Nisan 2005
Mesajlar
2
BAÞARDIM ARKADAÞLAR
İSTEYİNCE OLUYORMUÞ DEMEKKİ
YARDIMLARINIZ İÇİN
HEPİNİZE ÇOK TEÞEKKÜRLER :hihoho:
 
Katılım
4 Nisan 2007
Mesajlar
3
Excel Vers. ve Dili
Hem türkçe hem ingilizce xp ve vista
olmuyo olmuyo..mod&#252;l ne bilmiyom?verdi&#287;iniz linkler a&#231;&#305;lm&#305;yo?..herkes yapabiliyo, ben yapam&#305;yom..
 
Katılım
22 Aralık 2005
Mesajlar
336
Excel Vers. ve Dili
Office - 2019 - Türkçe
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.
 
Katılım
3 Mayıs 2006
Mesajlar
108
Mod&#252;le dedi&#287;in yer neresi biraz daha a&#231;ar m&#305;s&#305;n?benim gibi bilmeyenler olabilir diye d&#252;&#351;&#252;nd&#252;m.Selamlar..
 
Katılım
3 Mayıs 2006
Mesajlar
108
Kusura bakmay&#305;n arkada&#351;lar cahillik ettim mod&#252;l&#252; sordum kafam ba&#351;ka yerlerdeydi galiba Mod&#252;l&#252; biliyorum sak&#305;n bana cevap yazmay&#305;n bu konuda:)) Yaln&#305;z rakam&#305; yaz&#305;ya &#231;evirdikte ben metni b&#252;y&#252;k harf olsun istiyorum i&#231;inden de&#287;i&#351;tirdim ama olmad&#305; yard&#305;mc&#305; olur musunuz?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,543
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba

Form&#252;l&#252;n&#252;z&#252;n ba&#351;&#305;na =B&#220;Y&#220;KHARF(PARACEVIR(A1))

gibi kullanmal&#305;s&#305;n&#305;z
 
Katılım
23 Nisan 2007
Mesajlar
282
Excel Vers. ve Dili
Microsoft Office Excel 2007
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
 
Katılım
7 Ocak 2009
Mesajlar
7
Excel Vers. ve Dili
excel2003
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
 
Katılım
25 Aralık 2012
Mesajlar
1
Excel Vers. ve Dili
excell 2010
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
 
Katılım
1 Haziran 2008
Mesajlar
39
Excel Vers. ve Dili
2010 Türkçe
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ş
 
Üst