Excel Rakamla Yazilanlari Yaziya cevirme

[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

[ghostma_n]

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

[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

[velociraptor]

Macro üstte lakin küsüratta calisirmi denemek gerek.

[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