Sayıyı yazıya çevirmek

[ustunyeter]

Merhaba

Excel 2003 Türkçe

Excel bilgim çok az. Sayıyı yazıya çevirmek konusunda yardımlarınızı bekliyorum. Daha önceki konulara baktım. Sayfa da göndermiş oldukları ekleri açamadım. Yardımlarınız için şimdiden teşekkür ederim.

 

[Orion1]

Merhaba.
Aşağıdaki kodları boş bir modüle Kopyalayınız.
A1 hücresine bir sayı giriniz.B1 hücresine aşağıdaki formülü giriniz.
Bende Bu KTF'yi siteden aldım.
=Yaziyla(A1)

Function Yaziyla(Sayi#)

ReDim birler$(10), onlar$(10), basamak$(5)

birler$(0) = "": birler$(1) = "Bir"
birler$(2) = "İki": birler$(3) = "Üç"
birler$(4) = "Dört": birler$(5) = "Beş"
birler$(6) = "Altı": birler$(7) = "Yedi"
birler$(8) = "Sekiz": birler$(9) = "Dokuz"

onlar$(0) = "": onlar$(1) = "On"
onlar$(2) = "Yirmi": onlar$(3) = "Otuz"
onlar$(4) = "Kırk": onlar$(5) = "Elli"
onlar$(6) = "Altmış": onlar$(7) = "Yetmiş"
onlar$(8) = "Seksen": onlar$(9) = "Doksan"

basamak$(1) = "": basamak$(2) = "Bin"
basamak$(3) = "Milyon": basamak$(4) = "Milyar"
basamak$(5) = "Trilyon"

virgul2$ = "": cevap$ = "": onda$ = ""
'Burada Say# dğişkeni yani hücreden alınan değer
'1000 ile çarpılarak KG'a çevriliyor.
Say$ = Str$(Sayi#)
virgul% = InStr(1, Say$, ".")
If virgul% Then
Say$ = Right$(Say$, Len(Say$) - virgul%)
Select Case Len(Say$)
Case 6: onda$ = "Milyonda"
Case 5: onda$ = "Yüzbinde"
Case 4: onda$ = "Onbinde"
Case 3: onda$ = "Binde"
Case 2: onda$ = "Yüzde"
Case 1: onda$ = "Onda"
End Select
GoSub cevir

virgul2$ = " Tam " + onda$ + " " + cevap$
cevap$ = ""

Say$ = Str$(Sayi#)
Say$ = Left(Say$, virgul% - 1)
End If
GoSub cevir

If cevap$ = "" Then cevap$ = "Sıfır"
'Burada Yazı ile bulunmuş sonuca " KG" ekleniyor
Yaziyla = cevap$ + virgul2$

Exit Function

cevir:
X% = Len(Say$)
Say$ = String$(3 - (X% - Int(X% / 3) * 3), 48) + Say$
X% = Len(Say$) / 3
For i% = 1 To X%
uclu$ = Mid$(Say$, Len(Say$) - i% * 3 + 1, 3)
y% = Val(Mid$(uclu$, 1, 1))
O% = Val(Mid$(uclu$, 2, 1))
b% = Val(Mid$(uclu$, 3, 1))

yazi$ = ""
If y% <> 0 Then
If y% > 1 Then yazi$ = birler$(y%)
yazi$ = yazi$ + "Yüz"
End If

yazi$ = yazi$ + onlar$(O%) + birler$(b%)

If yazi$ <> "" Then
If LCase(yazi$) = "bir" And i% = 2 Then yazi$ = ""
cevap$ = yazi$ + basamak$(i%) + cevap$
End If
Next i%
Return
End Function