Virgülden Sonrakiri Üç rakamı çevirebilecek bir macro varmı?

[accula]

Bu başlık altında,birçok arkadaş çok güzel paylaşımlar yapmış.Hepside çok çok işime yaradı.Konuların hepsinde doğal olarak virgülden sonra 2 rakam yazıya çevirilecek şekilde macrolar paylaşılmış.
Ancak bana lazım olan virgülden sonraki 3 rakamıda çevirebilecek bir macro sayfası.Bilgimin yetersiz olması sebebi ile buradan paylaşılan formüller üzerinde oynayarak pek fazla yol kat edemedim.
Bilgili arkadaşların yardımlarını bekliyorum.
Şimdiden çok teşekkür ederim...
Saygılar.

 

[accula]

Virgülden sonraki 2 rakamı çevirebilen macroda,yapılacak değişiklikleri yazabilecek bir arkadaş da mı yok?
Teşekkürler...

 

[parametre]

Hem dosya ekleme hem konunu tam açıklama hemde sitemkar konusursanız bende yardım etmek istemem dogrusu

 

[accula]

Hem dosya ekleme hem konunu tam açıklama hemde sitemkar konusursanız bende yardım etmek istemem dogrusu

Dosya eklemediğim için sorunu tam anlatamadım demekki.
Aşağıdaki 2 örnek sorunumu anlatmamda faydalı olur sanırım.



318,726 ===> ThereeHundredEighteen Dinars,SevenHundredTwentysix Dirhams.

1654,045===> OneThousandSixHundredFiftyFour Dinars,FortyFive Dirhams.


Teşekkürler..

 

[accula]

Yardımcı olabilecek yokmu arkadaşlar...

 

[parametre]

bunlari bir module yaz YTL veye ykr olarak yazar ama istediğiniz para birimini oraya yazarsanız sorun çozulur kolay gelsin
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

 

[parametre]

hala donmediniz geri merak ettim ?

 

[accula]

Ufak bir problemi var sanırım.Ekli dosyayı incelemeniz mümkün mü?
Teşekkürler...
Dosya eklemede problem yaşıyorum.Denemeye devam ediyorum..

Makro ile aşağıdaki gibi yazıyor…
1.250,684
binikiyüzelli / binde altıyüzseksendört


Alttaki gibi çıkarsa süper olacak.
1.250,684
Binikiyüzelli YTL Altıyüzseksendört Ykr.

 

[Korhan Ayhan]

Merhaba,

Ekteki dosyayı incelermisiniz.

 

[accula]

Merhaba,

Ekteki dosyayı incelermisiniz.

Virgülden önceki kısımda bir problem var sanırım.Alttaki bölümü incelemeniz mümkün mü acaba..
İngilizce yapmak istersek macroda çok fazla oynama yapmamız gerekirmi?
Teşekkürler..


12.500,684 YüzYirmiBeşBin Dinars AltıYüzSeksenDört Dirhams

 

[lark]

Merhaba

Ekli dosyayı dener misiniz.
Kolay gelsin.

 

[accula]

Ekli dosyayı dener misiniz.
Kolay gelsin.

Evet,çok güzel çalışıyor.Çok teşekkür ederim, tüm yardımlarınız için...
Yardımcı olmaya çalışan arkadaşlara da teşekkür ederim.
Saygılar,İyi çalışmalar

 

[lark]

Rica ederim. Kolay gelsin.