Yazıyla Rakam Yazma Makrosu

Sık sık sorularda kullandığımız ,  yazıyla yazılan rakamlarla uğraş verdiğimiz için makrosunu buraya arşivlemek mantıklı geldi :)

Alt + F11 yazıp , makroyu yapıştırın ve excel üzerinde “yaziyla” komutunu kullanın.

Option Explicit

Dim veri As String

Sub Worksheet_Activate()
Dim parca1 As String
Dim parca2 As String
veri = Cells(40, 6).Value
If IsNumeric(veri) = True Then
Call Yaziver(41, 6)
Else
Cells(41, 6).Value = “”
End If
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If veri = Cells(40, 6).Value Then
Else
veri = Cells(40, 6).Value
If IsNumeric(veri) = True Then
Call Yaziver(41, 6)
Else
Cells(41, 6).Value = “”
End If
End If
End Sub

Sub Yaziver(esat As Integer, esut As Integer)
Dim parca1 As String
Dim parca2 As String
Dim i As Integer
Dim j As Integer
If Ondalik(veri) = True Then
parca1 = “”: parca2 = “”
For i = 1 To Len(veri)
If Mid(veri, i, 1) <> “,” Then
parca1 = parca1 & Mid(veri, i, 1)
Else
Exit For
End If
Next i
For j = i + 1 To Len(veri)
parca2 = parca2 & Mid(veri, j, 1)
Next j
Cells(esat, esut).Value = Yaziyla(parca1) & ” YTL virgul ” & Yaziyla(parca2) & ” YKr.”
Exit Sub
End If
Cells(esat, esut).Value = Yaziyla(veri) & ” YTL”
End Sub

Function Ondalik(veri As String) As Boolean
Dim i As Integer
If Len(veri) <= 1 Then
Ondalik = False
Exit Function
End If
For i = 1 To Len(veri)
If Mid(veri, i, 1) = “,” Then
Ondalik = True
Exit Function
End If
Next i
Ondalik = False
End Function

Function Yaziyla(sayi)
Dim b$(9)
Dim Y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)
Dim a$, e$, s$
Dim pozitif, X As Byte
If sayi = “” Then
Yaziyla = “”
Exit Function
End If
On Error GoTo Hata
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
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$
Yaziyla = s$
Exit Function
Hata:
Yaziyla = “Hata”
tamam:
End Function

Bir Cevap Yazın

Aşağıya bilgilerinizi girin veya oturum açmak için bir simgeye tıklayın:

WordPress.com Logosu

WordPress.com hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Twitter resmi

Twitter hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Facebook fotoğrafı

Facebook hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Google+ fotoğrafı

Google+ hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Connecting to %s

RunBursa

" Koş Bursa "

Traveller Goat | Gezgin Keçi

Traveller Goat's Fancy Land

okarakaya

Özge Karakaya Akyüz

Uzun Patika

Can Berk, spor ve yaşayarak öğrendiğim/öğrettiğim şeyler hakkında bir blog

Duygu | kurgusaldönüşüm

''Bütün bu yazdıklarım belirli bir anlamda, anlamsız ''

Hayata Dair...

Hayata Dair...

Prakkypedia

Corporate communications + Public Relations Adelaide

BİLİMSEL FELSEFE

KARANLIĞA MEŞALE

Mind Hacks

Neuroscience and psychology news and views.

MİNİKLER VE ANNELERİ

ANNE-ÇOCUK EĞİTİM BLOĞU/Çocuk ve eğitime dair...

yaz-gi

Kişisel Gelişim, Girişimcilik Hikayeleri ve hayata dair herşey - Meral Varuy

Sedat Eser

Hayata dair...

TED Blog

The TED Blog shares interesting news about TED, TED Talks video, the TED Prize and more.

Max Dunbar

'Fiction is the truth inside the lie, and the truth of this fiction is simple enough: the magic exists'

%d blogcu bunu beğendi: