-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Rakamların Yazıya Çevrilmesi
- Konbuyu başlatan ademazca
- Başlangıç tarihi
- Katılım
- 22 Haziran 2005
- Mesajlar
- 120
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ş..
ö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
Altın Üye
- Katılım
- 10 Mart 2005
- Mesajlar
- 751
- Excel Vers. ve Dili
- Microsoft Office LTSC Pr. Pl 2021 - 64 bit Türkçe
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
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
Ali
Özel Üye
- Katılım
- 21 Temmuz 2005
- Mesajlar
- 8,021
- Excel Vers. ve Dili
- Office 365 Türkçe
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
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
Altın Üye
- Katılım
- 10 Mart 2005
- Mesajlar
- 751
- Excel Vers. ve Dili
- Microsoft Office LTSC Pr. Pl 2021 - 64 bit Türkçe
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
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
- Katılım
- 22 Haziran 2005
- Mesajlar
- 120
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
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
- Katılım
- 22 Haziran 2005
- Mesajlar
- 120
Ekteki örnek bende çalışıyor.
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
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
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
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
Ali
Özel Üye
- Katılım
- 21 Temmuz 2005
- Mesajlar
- 8,021
- Excel Vers. ve Dili
- Office 365 Türkçe
Aşağıdaki linki inceleyin.
http://www.excel.web.tr/viewtopic.php?t=13234
http://www.excel.web.tr/viewtopic.php?t=13234