• DİKKAT

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

rakamı yazıya çevirme

Sn sıtkı

biede şu işlevi deneyiniz.

=EÐER(SAYIYAÇEVİR(SAÐDAN(A1;1))<5;A1+(5-SAYIYAÇEVİR(SAÐDAN(A1;1)))/100;A1)
 
yardımcı olurmusunuz

ben exelde bu vermiş olduğunuz programı bütün sayfalarda kullanmak istiyorum yardımcı olurmusunuz
 
Rakamı Yazıya Çevirme

Arkadaşlar ofis 2003 te makro olarak kaydettiğim "Rakamı Yazıya Çevir" makrosu Ofis 2007 de hata veriyor. Bu konuda bilgisi olan varsa bir zahmet açıklarsa sevinirim.
 
arkadaşlar visual basic nedir bu rakamı yazıya çevirme işlemini sanki excelle yeni başlar gibi anlatırsanız sevinirim hiç bişi anlayamadım cahilliğime verin.
 
merhaba &#246;ncelikle &#231;ok faydal&#305; bir forum olmu&#351; tebrik ederim ama ben epeyce yabanc&#305;y&#305;m bu konulara rakam&#305; yaz&#305;ya &#231;evirmek ile ilgili bir pr&#305;blemim var. &#246;nce visual basic ayarlar&#305;ndan falan bahsedildi anlayamad&#305;m herkes a&#351;inas&#305; oldu&#287;u konular&#305; anlatm&#305;&#351; ben anlayamad&#305;m nas&#305;l yapabilirim yard&#305;mc&#305; olurmusun?
 
Merhaba arkadaşlar,

Yukarıdaki makroyu aldım. A1 hücresindeki bir rakamı A2 hücresine yazı olarak nasıl yazarım yardımcı olurmusunuz lütfen
 
Levent Menteşoğlu' Alıntı:
Sn muygun

Uyarınızı dikkate alarak kodda bir değişiklik yaptım. Yaptığım değişiklik aşağıdaki gibidir. Ekide incelerseniz işlevin sıfır lira ve sıfır kuruş yazmadığını göreceksiniz.

Selamlar

[vb:1:377c858028]Public Function ParaCevir(Para)
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If Lira = 0 Then
ParaCevir = Cevir(Kurus) & " Kuruş"
Exit Function
End If
If Kurus = 0 Then
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira"
Exit Function
End If
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"
Exit Function
SayiDegil:
ParaCevir = "GİRİLEN DEÐER SAYI DEÐİL!"
End Function[/vb:1:377c858028]
Genişletmek için tıkla ...

Sn. Menteşoğlu "rakamı sayıya çevirmek" konusunda bence en başarılı formül sizin yukarıda yazmış olduğunu formüldür, kuşkusuz. Çok teşekkürler. Fakat şöyle küçük bir sorun yaşadım formül excel 2003 te sorunsuz çalışmakta lakin excel 2007 de hata vermektedir. Acaba ben mi beceremedim yoksa gerçekten formül excel 2007 de çalışmamaktamıdır? ilgi ve alakanıza şimdiden çok teşekkürler. Selamlar...
 
Arkadaslar benim pc de daha once Office 2003 kurulu idi.. sonra begenmedim ve office XP yukledim. Office surumunu degistirdikten sonra Paracevir fonksiyonu calismaz oldu.. eski *.xla dosyam duruyor. Ben bunu c:\windows un altina atarak calistirmistim. simdi yine eski yerinde ama calismiyor. #AD? seklinde hata veriyor.
 
sayın aLoneR aşağıdaki kodu vba da yeni bir module ekleyin çalışacaktır
Kodlar daha önceden bu siteden alıntıdır.bende sorunsuz çalışmaktadır.

kodu kaydettikten sonra formül =paracevir(C26;"TL";"KRŞ")

Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruş")
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
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 = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
Genişletmek için tıkla ...
 
Mustafa Bey ilginizden dolayi cok tesekkur ederim. Sanirim benim sorunum kodlarla degil.
soyle ki.. benim sistemimde kurulu olan office de sanirim cok ileri duzeyde guvenlik engeli var ve makrolarin calismasina musaade etmiyor. su ana kadar bunu cozebildim. *.xla uzantili dosyayi manuel olarak bir defa calistirinca butun excel sayfalarinda sorunsuz calisiyor. Fakat excel uygulamasindan tamamen cikip yeniden sadece excel acmaya kalkinca baglanti guncellemesi soruyor. eskiden sormuyordu. baglantilari guncelle deyince de makronun yerini bulamiyor ve yine hata veriyor.
 
aLoneR' Alıntı:
Mustafa Bey ilginizden dolayi cok tesekkur ederim. Sanirim benim sorunum kodlarla degil.
soyle ki.. benim sistemimde kurulu olan office de sanirim cok ileri duzeyde guvenlik engeli var ve makrolarin calismasina musaade etmiyor. su ana kadar bunu cozebildim. *.xla uzantili dosyayi manuel olarak bir defa calistirinca butun excel sayfalarinda sorunsuz calisiyor. Fakat excel uygulamasindan tamamen cikip yeniden sadece excel acmaya kalkinca baglanti guncellemesi soruyor. eskiden sormuyordu. baglantilari guncelle deyince de makronun yerini bulamiyor ve yine hata veriyor.
Genişletmek için tıkla ...

Dostum *.xla türü eklenti ile rakamı yazıya çevrilen dosyalar kopyalanınca veya her hangi bir makinada hazırladığın kitabı farklı bir makinada açınca da aynı hatayı veriyor. Bunun çözümü rakamı yazıya çeviren formülün bulunduğu hücrelerdeki formülleri yenilemen gerekiyor.
Yada excelin genelinde bu uygulamayı çalıştırmak istemezsen eğer aşağıdaki kodu yeni bir modül içerisine yapıştırman yeterli olur.
Bu uygulama sadece modülün eklendiği kitapta çalışır, başka uygulamalarda da kullanmak istersen aynı modülü diğer kitaplarına da kopyalaman gerekir.
Kodlar forumdan alıntıdır.
Kod: 
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

Function yaz$(sayi)


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(Int(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 hata1

Next x



If Len(a$) > 15 Then GoTo hata1

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$

GoTo tamam1

hata1: s$ = "Hata1"

tamam1:

''''''''''''


a$ = Str(CInt((sayi * 100) - Int(sayi) * 100))



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 hata2



Next x



If Len(a$) > 15 Then GoTo hata2

a$ = String(15 - Len(a$), "0") + a$



For x = 1 To 15

v(x) = Val(Mid$(a$, x, 1))

Next x



kr$ = ""

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"

kr$ = kr$ + e$

Next x



If kr$ = "" Then kr$ = "Sıfır"

If pozitif = 0 Then kr$ = "Eksi" + kr$


'''''''''''

GoTo tamam2

hata2: kr$ = "Hata2"

tamam2:

If s$ = "Sıfır" And kr$ <> "Sıfır" Then yaz$ = kr$ + "-KR"
If s$ <> "Sıfır" And kr$ = "Sıfır" Then yaz$ = s$ + "-TL "
If s$ = "Sıfır" And kr$ = "Sıfır" Then yaz$ = ""
If s$ <> "Sıfır" And kr$ <> "Sıfır" Then yaz$ = s$ + "-TL " + kr$ + "-KR"

End Function
 
ılgınızden dolayı tesekkurler arkadaslar. Sorunu cozmek uzereyım. Emeklerınız ıcın cok sagolun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst