İyinet'e Hoşgeldiniz!

Türkiye'nin En Eski Webmaster Forum'una Hemen Kayıt Olun!

Kayıt Ol!

Excelde rakamı sayıya çevirme?

O

OnlineCasinoLTD.CoM

Misafir
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) = "sevken"
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
 
O

OnlineCasinoLTD.CoM

Misafir
çö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) = "sevken"
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
 

Türkiye’nin ilk webmaster forum sitesi iyinet.com'da forum üyeleri tarafından yapılan tüm paylaşımlardan; Türk Ceza Kanunu’nun 20. Maddesinin, 5651 Sayılı Kanununun 4. maddesinin 2. fıkrasına göre, paylaşım yapan üyeler sorumludur.

Backlink ve Tanıtım Yazısı için iletişime geçmek için Skype Adresimiz: .cid.1580508955483fe5

Üst