Excel Rakamla Yazilanlari Yaziya cevirme

Excel, Word, Access, Power Point programlarıyla ilgili ipuçları ve bilgi paylaşım alanıdır.
Cevapla
Kullanıcı avatarı
velociraptor
Yottabyte3
Yottabyte3
Mesajlar: 28201
Kayıt: 14 Mar 2006, 02:33
cinsiyet: Erkek

Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen velociraptor » 16 Mar 2006, 22:35

Excel Rakamla Yazilanlari Yaziya cevirme (Excel Macro) excel'i ac, ALT+F11 ile VBE editörünü ac. insert menüsünden 'module'e tikla. acilan sayfaya asagidaki makroyu yapistir. daha sonra VBE penceresini kapat. excel calisma kitabini "sayiyaz" ismiyle kaydet. daha sonra dosya-farkli kaydet'e gir. altta kayit türünden "Microsoft office excel eklentisini" sec. kayit yeri otomatik olarak "AddIns" klasörü olarak secilmis olmali. ayni adla (sayiyaz) kaydet. daha sonra exceli kapat ve tekrar ac. Araclar menüsünden Eklentiler'e tikla. burada "sayiyaz"in kutucugunu isaretle ve tamama tikla. artik formülü kullanabilirsin.
örnegin A1'de 15000 varsa formülün : "=yaziyla (A1)" veya "=YAZIYLA(A1)"
ya da "=yaziyla (15000)" veya "=YAZIYLA(15000)" seklinde de kullanabilirsin.

Kod: Tümünü seç

Dim b$(9) 
Dim y$(9) 
Dim m$(4) 
Dim v(15) 
Dim c(3) 

Function Yaziyla$(sayi) 

b$(0) = "" 
b$(1) = "Bir" 
b$(2) = "İki" 
b$(3) = "üc" 
b$(4) = "Dört" 
b$(5) = "Bes" 
b$(6) = "Alti" 
b$(7) = "Yedi" 
b$(8) = "Sekiz" 
b$(9) = "Dokuz" 

y$(0) = "" 
y$(1) = "On" 
y$(2) = "Yirmi" 
y$(3) = "Otuz" 
y$(4) = "Kirk" 
y$(5) = "Elli" 
y$(6) = "Altmis" 
y$(7) = "Yetmis" 
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$ = "Sifir" 
If pozitif = 0 Then s$ = "Eksi" + s$ 
Yaziyla$ = s$ 
GoTo tamam 
hata: Yaziyla$ = "Hata" 
tamam: 
End Function 

ALINTIDIR



Kullanıcı avatarı
ghostma_n
Kilobyte1
Kilobyte1
Mesajlar: 289
Kayıt: 18 Tem 2006, 13:18
cinsiyet: Erkek
Konum: İstanbul

Mesaj gönderen ghostma_n » 06 May 2008, 22:58

önemli bir konu paylasım için tesekkürler

tufaz
Bit
Bit
Mesajlar: 8
Kayıt: 22 May 2006, 02:14

Re: Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen tufaz » 29 Kas 2009, 19:08

Arkadaşlar yardım lütfen rakam ile yazılanları "123,35" yazı ile "Yüz Yirmi Üç Lira Otuz Beş Kuruş" olarak yazan bir makroyu yazıp nasıl çalıştırabilirim. Bir haftadan beri dolaşmadığım site kalmadı bir türlü başaramadım. Verilen makroları bir türlü çalıştırmayı başaramadım

Kullanıcı avatarı
velociraptor
Yottabyte3
Yottabyte3
Mesajlar: 28201
Kayıt: 14 Mar 2006, 02:33
cinsiyet: Erkek

Re: Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen velociraptor » 29 Kas 2009, 19:12

Macro üstte lakin küsüratta calisirmi denemek gerek.
Knowledge determines destiny, And ye shall know the Truth and the Truth shall make you free

tufaz
Bit
Bit
Mesajlar: 8
Kayıt: 22 May 2006, 02:14

Re: Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen tufaz » 30 Kas 2009, 00:21

Kod: Tümünü seç

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
"yukarıda verdiğim makro rakamları paraya ve metne çevirir.formülü de =ParaCevir(A1) ve =Cevir(A1) şeklindedir. (A1, rakamın olduğu örnek hücre)
exceli açıyorsun alt+F11 e basıyorsun.insert sekmesinde module' yi açıyor ve yukarıda verdiğim makroyu yapıştırıyorsun. kapatıp excele dönüyorsun.macron hazır demektir. tüm excel uygulamalarında kullanmak istersen sayfayı farklı kaydet deyip kayıt türünü microsoft office excel eklentisi(*.xla) yapıp dosya adını da ParaCevir diyorsun ve addins klasörüne kaydediyorsun. daha sonra excelde araçlar sekmesinde eklentileri tıklatıp kaydettiğin macroyu(ParaCevir) bulup kutuya işaret koyuyorsun. artık her excel uygulamasında kullanabilirsin.

not:2009 yılında liradan yeni ibaresi kalkacağı için formülü lira ve kuruş olarak belirttim. yani A1 hücresindeki 16,25 sayısını, =ParaCevir(A1) formülü kullanınca onaltı lira yirmibeş kuruş olarak yazacaktır. Sen YTL ve YKr. yazsın istiyorsan ilk satırdaki "Lira" ve "Kuruş" yazan yerleri "YTL" ve "YKr" şeklinde değiştirebilirsin. o zaman Onaltı YTL Yirmibeş YKr yazar.
A1 hücresindeki 625 sayısını =Cevir(A1) formülü, Altıyüzyirmibeş olarak yazar."

Yukarıda yazılanlar işe yarıyor hazırlayanların emeğine sağlık, teşekkürler

Cevapla