rakam yazıyla çıksın

[ahmetvezir]

hücreye yazdığım rakam başka bir hücrede yazıyla çıksın

ör.100

yüz gibi
teşekkürler

 

[Mahmut Bayram]

syn ahmetvezir,
bir modüle aşağıdaki kodları yapıştırınız
[vb:1:6997e69aad]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$ = ""

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$ = " virgül " + onda$ + " " + cevap$
cevap$ = ""

Say$ = Str$(Sayi#)
Say$ = Left(Say$, virgul% - 1)
End If
GoSub cevir
'If cevap$ = "" And Mid$(Str$(Sayi#), 2, 1) = 0 Then cevap$ = "Sıfır"
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[/vb:1:6997e69aad]

a1 de 1569 olsun
b1 hücresine şunu yazın
[vb:1:6997e69aad]=YAZIYLA(A1)[/vb:1:6997e69aad]

sanırım anladınız olayı