• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

parayı yazıya çevirme

Katılım
10 Nisan 2006
Mesajlar
13
Excel Vers. ve Dili
EXCEL 2010 TR
Herkese iyi günler,
biliyorum bu konu formda var neden arama yaptırıp cevabını almıyorsun diyeceksiniz ama, aratıpta bulduklarım pek işime yaramadı.
Sizden ricam; excelde (excel-2007 kullanıyorum) hem YTL hem Dolar hemde Avro rakamlarım var.
YTL'yi yazıya çevireceğim zaman örneğin, 1250,85 rakamını Binikiyüzelli YTL, Seksenbeş YKR yazsın. Eğer çevirmek istediğim rakam dolar yada avro rakamı ise örneğin 2500 dolar rakamını sadece İkibinbeşyüz yazsın (ben sonuna ilgili para birimini formülle ekleyebilirim).
Galiba bunun için iki ayrı macro gerekecek. Forumda bununla ilgili çözüm bulamadığım için buraya yeniden yazdım,
bu konuda bana yardımcı olacak arkadaşlarıma şimdiden çok teşekkür ediyorum.
 
merhabalar

çalışma kitabınızın Kodlar bölümüne Aşağıdaki Kodları kopyalararak hücreye = YTL formülünü veriniz. sanırım istediğiniz doğru anladıysam oldu

Kod:
Function YTL(sayi)
    Dim sWks As String
    sWks = InputBox(prompt:="ANA PARA BİRİMİNİ GİRİNİZ:", Default:="YENİ TÜRK LİRASI")
    ANAPARA = sWks
    sWks1 = InputBox(prompt:="ONDALIK PARA BİRİMİNİ GİRİNİZ:", Default:="YENİ KURUŞ")
    ONDALIK = sWks1
    x = InStr(1, sayi, ",")
    If x > 0 Then
        Lira = yaz$(Mid(sayi, 1, x - 1)) & " " & ANAPARA & " "
        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) & " " & ONDALIK & " "
        Else
        Lira = yaz$(sayi) & ANAPARA
    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&#252;z"
Else
e$ = b$(c(1)) + "Y&#220;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&#305;f&#305;r"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
 
Son düzenleme:
Sorunuzun Tam Çözümü

Sorunuzun Tam Çözümü Bu olsa Gerek.
 
Son düzenleme:
peki bu kodu nereye nasıl işleyeceğiz ve nasıl kullanacağız yapamadım makrolaradan visual basic e atıyorum ama kullanamıyorum bana yol gösterir misiniz
 
elinize sağlık, teşekkürler.
 
Geri
Üst