yazı ile rakam yazılması

[alfa&omega]

a3 hücresinde ki değişken rakamsal veriyi b3 hücresinde yazı ile yazılması;


a3: 55
b3: elli beş

şeklinde olacak a3 deki rakam değiştikçe b3 te buna göre değişecek,

ilgilenen arkadaşlara şimdiden teşekkürler

 

[serkankeser]

Merhaba
Aşağıdaki link sorunuzu çözer galiba.
http://www.excel.web.tr/showthread.php?t=2183

 

[alfa&omega]

formulle yapılabılıyor bıldıgım kadarıyla ama sımdı hatırlamıyorum makro kasar bıraz, yardımcı olursanız sevınırım

 

[İdris SERDAR]

Bu kodlar sayıyı yazıya dönüştürür.
Kodları bir module’nin içine kopayalayınız.

İlgili hücreye formülü = Yaziyla(Sayı) veya =Yaziyla(hücre adresi) şeklinde girin.

Function Yaziyla(sayi#)

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

birler$(0) = "": birler$(1) = "bir"
birler$(2) = "iki": 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$ = " / " + 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



Bu kodlar sayıyı YTL,YKR şeklinde yazıya dönüştürür.
Kodları bir module’nin içine kopayalayınız.

İlgili hücreye formülü = Yaziyacevir(Sayı) veya = Yaziyacevir(hücre adresi) şeklinde girin.


Function yaziyacevir(rakam)

Dim grup(5), sayi(10, 3), basamak(5), oku(3)
sayi(0, 1) = "": sayi(0, 2) = "": sayi(0, 3) = ""
sayi(1, 1) = "YÜZ": sayi(1, 2) = "ON": sayi(1, 3) = "BİR"
sayi(2, 1) = "İKİYÜZ": sayi(2, 2) = "YİRMİ": sayi(2, 3) = "İKİ"
sayi(3, 1) = "ÜÇYÜZ": sayi(3, 2) = "OTUZ": sayi(3, 3) = "ÜÇ"
sayi(4, 1) = "DÖRTYÜZ": sayi(4, 2) = "KIRK": sayi(4, 3) = "DÖRT"
sayi(5, 1) = "BEŞYÜZ": sayi(5, 2) = "ELLİ": sayi(5, 3) = "BEŞ"
sayi(6, 1) = "ALTIYÜZ": sayi(6, 2) = "ALTMIŞ": sayi(6, 3) = "ALTI"
sayi(7, 1) = "YEDİYÜZ": sayi(7, 2) = "YETMİŞ": sayi(7, 3) = "YEDİ"
sayi(8, 1) = "SEKİZYÜZ": sayi(8, 2) = "SEKSEN": sayi(8, 3) = "SEKİZ"
sayi(9, 1) = "DOKUZYÜZ": sayi(9, 2) = "DOKSAN": sayi(9, 3) = "DOKUZ"
basamak(5) = "TRİLYON"
basamak(4) = "MİLYAR"
basamak(3) = "MİLYON"
basamak(2) = "BİN"
basamak(1) = ""
lira = Int(rakam)

kucuk = 1 ' Küçük harflerle yazması için

If kucuk = 1 Then
For x = 0 To 9
For y = 1 To 3
sayi(x, y) = Replace(sayi(x, y), "I", "ı")
sayi(x, y) = Replace(sayi(x, y), "İ", "i")
sayi(x, y) = LCase(sayi(x, y))
Next
Next

For y = 2 To 5
basamak = Replace(basamak, "I", "ı")
basamak = Replace(basamak, "İ", "i")
basamak = LCase(basamak)
Next
End If


kurus = Round(rakam - lira, 2) * 100
If Len(lira) > 15 Then
MsgBox ("Bu fonksiyon en fazla 15 haneli sayılar için çalışır.")
End
End If
kalan = lira
yaziyacevir = ""

For x = 1 To 5
A = 15 - 3 * x
If Len(lira) > A Then
grup(6 - x) = Int(kalan / 10 ^ A)
kalan = kalan - (grup(6 - x) * 10 ^ A)
End If

Next x

If grup(5) > 0 Then
oku(1) = Int(grup(5) / 100)
baskalan = grup(5) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(5)
End If

If grup(4) > 0 Then
oku(1) = Int(grup(4) / 100)
baskalan = grup(4) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(4)
End If

If grup(3) > 0 Then
oku(1) = Int(grup(3) / 100)
baskalan = grup(3) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(3)
End If

If grup(2) = 1 Then
yaziyacevir = yaziyacevir + "BİN"
End If

If grup(2) > 1 Then
oku(1) = Int(grup(2) / 100)
baskalan = grup(2) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(2)
End If

If grup(1) > 0 Then
oku(1) = Int(grup(1) / 100)
baskalan = grup(1) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(1)
End If
yaziyacevir = yaziyacevir + "YTL."
If kurus > 0 Then
oku(2) = 0
If Len(kurus) > 1 Then
oku(2) = Int(kurus / 10)
End If
oku(3) = kurus - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(2), 2) + sayi(oku(3), 3) + "YKR."
End If
End Function

 

[İdris SERDAR]

formulle yapılabılıyor bıldıgım kadarıyla ama sımdı hatırlamıyorum makro kasar bıraz, yardımcı olursanız sevınırım

Excelin yerleşik fonksiyonları ile yapılmaz. Ancak bu kodlarını yukarıda verdiğim kullanıcı tanımlı fonksiyonlar ile mümkündür.