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
Yottabyte4
Yottabyte4
Mesajlar: 34726
Kayıt: 14 Mar 2006, 02:33
cinsiyet: Erkek

Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen velociraptor »

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: 291
Kayıt: 18 Tem 2006, 13:18
cinsiyet: Erkek
Konum: İstanbul

Mesaj gönderen ghostma_n »

ö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 »

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
Yottabyte4
Yottabyte4
Mesajlar: 34726
Kayıt: 14 Mar 2006, 02:33
cinsiyet: Erkek

Re: Excel Rakamla Yazilanlari Yaziya cevirme

Mesaj gönderen velociraptor »

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 »

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