Rakamların Yazıya Çevrilmesi

[ademazca]

excel sayfamda rakamın yazıya dönüştürmek için ne yapa bilirim
Ã?r: 2.500,00-YTL yi nasıl otomatik olarak ikibinbeşyüzyenitürklirsı oalabilir

 

[osiso]

RAKAMI YAZIYA DÃ?NÜÞTÜREN ÇEVÝRGEÇ

İNÞALLAH İÞİNE YARAR BENİM ÇOK İÞİME YARADI SADECE RAKAMI YAZ VE ENTER E BAS KOLAY GELSİN.

 

[HIDROKINON]

Aşağıdaki kodu modül'e yapıştırıp, istediğiniz bir hücreden bu kod ile oluşturmuş olduğunuz fonksiyon olan "yaz'ı" kullanın.
örnek : =yaz(B6) gibi

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







Not: Bu kod excel.web.tr'da ismini hatırlayamadığım bir arkadaşımızın bir soruya vermiş olduğu cevaptan alıntıdır. Bir de göndedikten sonra farkettim , soruyu soran kişi muhtemelen cevabını bulmuş olmalı. Zira nerdeyse 2 sene olmuş..

 

[KuTuKa]

sayınHIDROKINON, makronun başında bu şekilde bir makro olsa daha iyi olacak

Function YTL(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " Yeni Türk Lirası "
TempKurus = Mid(sayi, x + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
Kurus = yaz$(TempKurus) & " Kuruş"
Else
Lira = yaz$(sayi) & " Yeni Türk Lirası "
End If
YTL = Lira & Kurus
End Function



ayrıca 1153,52 ytl yazdığımızda neden hata alıyoruz herhalde makro da bir eksiklik var.

saygılar
hall kutuka

 

[ahkan]

SONUNA YTL YAZDIÐINIZDA
BUNU SAYI OLARAK GÃ?RMÜYOR OLABİLİR

100.25 YTL YAZILI OLSUN YİNEDE BUNU YAZSIN İSTERSENİZ
HCRELERİ BİÇİMLENDİRİ KULLANMAYI DENEYİN

SAYGILAR

 

[KuTuKa]

yok zaten ytl yazmıyorum sadece 1153,52 bundada hata veriyor

 

[Ali]

Sayın KuTuKa,

Aşağıdaki kodları modüle ekleyerek denermisiniz. Muhtemelen sorununuz düzelecektir.



Public Function yaziyacevir(Lira)
Dim LiraStr As String
Dim YTL As String, Kurus As String

If Not IsNumeric(Lira) Then GoTo Sayiolmali

LiraStr = Format(Abs(Lira), "0.00")

YTL = Left(LiraStr, Len(LiraStr) - 3)
Kurus = Right(LiraStr, 2)

yaziyacevir = IIf(Lira < 0, "Eksi ", "") & Cevir(YTL) & " YTL " & Cevir(Kurus) & " Kr"

Exit Function

Sayiolmali:
yaziyacevir = "Lütfen sayı girin"
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 = "00"

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

 

[KuTuKa]

arkadaşlar şunu söyliyeyim bu site gibi bilgiyi paylaşan insanlar türk toplumunda var oldukça bizim sırtımız yere gelmez.
sayın fructose, vermiş olduğunuz çabuk cevap için teşşekürler yaklaşık 23 saatir uykusuzum yarın bakacağım cevabınıza ama mutlak suretle işi çözmüşsünüzdür
saygılar
halil kutuka

 

[KuTuKa]

arkadaşlar 1434 yazıyorum bu makrolarla sonuca ulaşabiliyorum 1434.32 yazıyorum hata alıyorum bunun sebebi nedir?dosyayı da gönderiyorum

 

[Ali]

Sayın KuTuKa, mutlaka nokta ile yazacaksanız Denetim Masasından-Bölgesel Seçenekler-Sayılar-Ondalık Simgesindeki virgül yerine nokta yazıp-Uygula düğmesini tıkladığınızda 1434.32 olarak kullanabilirsiniz.

 

[KuTuKa]

bende sayı:123.456.789,00
para birimi:123.456.789,00 YTL var bunu ne yapmam gerekir?


şu şekildemi
123.456.789.00
123.456.789.00 YTL

 

[HIDROKINON]

Bu haliyle daha güzel çalışıyor sanki

Function YTL(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " Ytl "
TempKurus = Mid(sayi, x + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
Kurus = yaz$(TempKurus) & " Ykr"
Else
Lira = yaz$(sayi) & " Ytl "
End If
YTL = Lira & Kurus
End Function
'
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
a$ = ""
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$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function

 

[KuTuKa]

Olmadı :agla:

 

[HIDROKINON]

Ekteki örnek bende çalışıyor.

 

[KuTuKa]

heyt be :mutlu: en sonunda olmuş ama benim dosyamdaki neden olmadı anlayamadım ama olsun :mutlu:
saygılar
halil kutuka

 

[talatcd]

YazıylaYTL

Function YAZIYLAYTL(sayi, Optional tür As Byte = 0)
'Parasal Rakamı yazıyla yazar
'
'Talat ÇELİKDEMİR
'Elazığ İl Milli Eğitim Müdürlüğü
'Mutemedi
'
'http://talatcd.sitemynet.com/Talat/
'talatcd@hotmail.com
'
'01/11/2004

'tür=0 YTL ve YKR
' 1 Yalnız YTL
' 2 Tam sayı ise yalnız YTL

Dim tam
Dim küsur As Byte
Dim syazi As String

If IsNumeric(sayi) And Len(Format(sayi)) < 16 Then
sayi = Int(sayi * 100) / 100
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
tam = Int(sayi)
küsur = (sayi - tam) * 100
syazi = syazi & yçevir(tam) & " YTL "
If tür = 0 Or (tür = 2 And küsur <> 0) Then
syazi = syazi & yçevir(küsur) & " YKR"
End If
Else
syazi = "Hata"
End If
YAZIYLAYTL = syazi
End Function

 

[memoli_68]

kolay gelsin arkadaşlar yeni üye oldum forumu çok beğendim neyse konuya gelimmm. Bu eklentiyi yapmak istiyorum ama pek fazla bilgim yok biraz konuyu açarmısınız yani nasıl yapacağımız hakkında şimdidenteşekkürler

 

[by_musty]

arkadaşlar ben buların hepsini denedim
ancak

1.235,35 ytl
yazdığım rakamı yazıya çevirmiyo aslında çeviriyo ama küsurata gelince hata veriyor. Ben bu yazıyı şu şekilde;
binikiyüzotuşbeş ytl otuzbeş ykr olarak nasıl yapabilirim yardımcı olursanız sevinirim

 

[by_musty]

bu konu bir an önce çözmem lazım arkadaşlar yardımcı olurmusunuz

 

[Ali]

Aşağıdaki linki inceleyin.
http://www.excel.web.tr/viewtopic.php?t=13234