astropaykartsatis.net
User Tag List

Yeni Konu Aç Cevap Yaz
17.01.2006, 12:10 1 (permalink)
OnlineCasinoLTD.CoM
  • Üyelik Tarihi
  • Ticaret Sayısı
  • Mesajlarn/a
Excelde rakamı sayıya çevirme? #permalink (permalink)
Excelde aşağıdaki formul ile sayıyı rakama çevire biliyoruz....

Ancak burada virgülden sonra 2 basamaklı olan sayılarda hata veriyor..

örnegin bir sütunda döviz türü, bir sütunda tutar olsun...

Döviz Tutar
Usd 213,92
Euro 57,01
Ytl 233,77

Bunların şöyle yazıya çevirmeli...
Döviz Tutar Yazı ile
Usd 213,92 İkiYüzOnüç Usd Doksanİki Cent
Euro 57,01 ElliYedi Euro Bir Cent
Ytl 133,77 YüzOtuzüç Ytl YetmişYedi Ykr
gibi..

Bunu nasıl yaparız...

Formul aşağıdaki gibi,

Rakamı Metne Çeviren Fonksiyon

Siz hücreye rakamı giriyorsunuz ve bu rakamın metne çevrildiğini görüyorsunuz. Hücreye =yaz (rakam ya da hücre adresi) fonksiyonunu giriyorsunuz.

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
Alıntı ile Cevapla
17.01.2006, 14:28 2 (permalink)
OnlineCasinoLTD.CoM
  • Üyelik Tarihi
  • Ticaret Sayısı
  • Mesajlarn/a
çözümü biraz kasınca buldum...

birkaç haftadır hyiplerle yatıp kalkınca jeton geç düştü

ardadaşlar ytl,usd ve euro için aşağıdaki formulu kullanabilirsiniz...

=YTL(Sayi) =EURO(Sayi) =USD(Sayi) seklinde kullanilacak...

aşağıdaki kodu Module kısmına yerleştirirsiniz..

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 USD(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " Usd "
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) & " Cent"
Else
Lira = yaz$(sayi) & " Usd "
End If
USD = Lira & Kurus
End Function

Function EURO(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " Euro "
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) & " Cent"
Else
Lira = yaz$(sayi) & " Euro "
End If
EURO = 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


Hyip - OnlineCasinoLTD
Alıntı ile Cevapla
Yeni Konu Aç Cevap Yaz
Şu an bu konuyu okuyan kişi sayısı: 1 (0 üye ve 1 misafir)
 
Seçenekler
Yetkileriniz
Konu Acma Yetkiniz Yok Cevap Yazma Yetkiniz Yok Eklenti Yükleme Yetkiniz Yok Mesajınızı Değiştirme Yetkiniz Yok
BB code is Açık Smileler Açık [IMG] Kodları Açık HTML-Kodu Kapalı
Trackbacks are Açık
Pingbacks are Açık
Refbacks are Açık
Forum Kuralları
Benzer Konular
Konu Konuyu Başlatan Forum Cevap Son Mesaj
Bu rakamı kimse beklemiyordu! abuz89 Google + 1 23.07.2011 14:54
excell rakamı yazıya çevirme Anonymous MS Office 3 14.08.2008 00:17
Acil cevap gerekti ASP de belli sayıya kadar karakter cekme. annudora ASP .NET 10 9.03.2007 12:47
Excelde ürün agaci? wglinkmanager.com MS Office 3 28.02.2005 12:09
EXCELDE LİSTE OLUŞTURMA Anonymous MS Office 4 8.02.2005 17:09

Forum Saati: 20:20. Zaman dilimi GMT +3 olarak ayarlanmıştır.
Powered by vBulletin™ Version 3.8.7
Copyright © 2017 vBulletin Solutions, Inc. All rights reserved.