ondalık sayıları yazıya çevirmek

[puslukurt]

arkadaşlar bildiğiniz aşağıdaki kod rakamı sayıya çeviriyor a1 hücresine 23,5 yazdığımda "YirmiÜç Tam Onda Beş" diye yazıyor benim istediğim "YİRMİÜÇBİNBEŞYÜZ KG" yazmasını istiyorum. Şimdi üstadlarım bana kızacak bu konu hakkında çok konu var diye ama bulduğum linklerin hepsi silinmiş. Yardımlarınız için teşekkürler



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&#252;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

 

[xxcell]

yukardaki kodda a&#351;a&#287;&#305;daki k&#305;rm&#305;z&#305; ilaveleri yaparsan&#305;z dedi&#287;iniz oluyor.

Say$ = Str$(Sayi#) * 1000

Yaziyla = cevap$ + virgul2$ & " KG"

 

[puslukurt]

sayın xxcell
dediklerinizi aynen yaptım. ondalıksız sayılarda çok gzel 15 yazdığımda "onbeşbin KG" yazıyor ancak ondalıklı sayılarda örnek 15,5 u "onbeşbinbeşyüz kg" yazması gerekirken "yüzellibeşbin kg" yazıyor ilginiz için teşekkür ederim

 

[Ali]

bu konu hakkında çok konu var diye ama bulduğum linklerin hepsi silinmiş. Yardımlarınız için teşekkürler

Sayıyı Yazıya Çevirme Uygulamaları


burada uygulamalar var,silinmemiş.

 

[Seyit Tiken]

Bu şekilde deneyiniz. Yapamadığınız bir şey olursa genele(foruma) sorun. Özele sormaktan daha iyi sonuç alırsınız.

=Cevir(A1)&" Kg"

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")
SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i
Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "Sıfır"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

 

[Necdet]

Merhaba,

İşyerimden bir arkadaşımın yazdığı (farklı bir mantıkla) rakamı yazıya çeviren fonksiyonu burada sizinle paylaşmak istiyorum.

Kendisinin izniyle tabi.

Sayın Puslukurt, ekteki dosyada nasıl kullanıldığını inceleyiniz, KG ve Gr olarak yazıyor, sadece KG yazmasını isterseniz IF(EĞER)'li kullanmanız gerekir.

Function YazRakam(sayi)
 
B = Array("", "", "bin", "milyon", "milyar", "trilyon")
Dim A(0 To 2, 0 To 9)
A(0, 0) = ""
A(0, 1) = "yüz"
A(0, 2) = "ikiyüz"
A(0, 3) = "üçyüz"
A(0, 4) = "dörtyüz"
A(0, 5) = "beşyüz"
A(0, 6) = "altıyüz"
A(0, 7) = "yediyüz"
A(0, 8) = "sekizyüz"
A(0, 9) = "dokuzyüz"
 
A(1, 0) = ""
A(1, 1) = "bir"
A(1, 2) = "iki"
A(1, 3) = "üç"
A(1, 4) = "dört"
A(1, 5) = "beş"
A(1, 6) = "altı"
A(1, 7) = "yedi"
A(1, 8) = "sekiz"
A(1, 9) = "dokuz"
 
A(2, 0) = ""
A(2, 1) = "on"
A(2, 2) = "yirmi"
A(2, 3) = "otuz"
A(2, 4) = "kırk"
A(2, 5) = "elli"
A(2, 6) = "altmış"
A(2, 7) = "yetmiş"
A(2, 8) = "seksen"
A(2, 9) = "doksan"
 
kusurat = Format((sayi - Int(sayi)) * 100, "00")
sayi = String(15 - Len(Trim(Int(sayi))), "0") + Trim(Int(sayi))
 
For i = 1 To Len(sayi)
    If i Mod 3 = 1 Then
       k = k + 1
       If (Mid(sayi, Len(sayi) - i - 1, 3)) <> "000" Then yazi = B(k) & yazi
    End If
    yazi = A(i Mod 3, Val(Mid(sayi, Len(sayi) + 1 - i, 1))) & yazi
Next
If Left(yazi, 6) = "birbin" Then yazi = Replace(yazi, "birbin", "bin")
yazi = yazi + " KG "
If kusurat > 0 Then yazi = yazi + A(2, Val(Left(kusurat, 1))) + A(1, Val(Right(kusurat, 1))) + " Gr"
YazRakam = yazi
 
End Function

 

[puslukurt]

Teşekkür

necdet bey size bu çalışmayı yapan arkadaşınıza teşekkürler elinize sağlık iyi çalışmalar

 

[roj88]

emeginize saglik

 

[zaruri]

Necdet üstadın eklediği Kod' u TL. ve Krş. olarak görmek ve her rakamın baş harfini büyük olarak kullanmak için.

 

[zaruri]

Function YazRakam(sayi)

B = Array("", "", "bin", "milyon", "milyar", "trilyon")
Dim A(0 To 2, 0 To 9)
A(0, 0) = ""
A(0, 1) = "Yüz"
A(0, 2) = "İkiyüz"
A(0, 3) = "Üçyüz"
A(0, 4) = "Dörtyüz"
A(0, 5) = "Beşyüz"
A(0, 6) = "Altıyüz"
A(0, 7) = "Yediyüz"
A(0, 8) = "Sekizyüz"
A(0, 9) = "Dokuzyüz"

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

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

kusurat = Format((sayi - Int(sayi)) * 100, "00")
sayi = String(15 - Len(Trim(Int(sayi))), "0") + Trim(Int(sayi))

For i = 1 To Len(sayi)
If i Mod 3 = 1 Then
k = k + 1
If (Mid(sayi, Len(sayi) - i - 1, 3)) <> "000" Then yazi = B(k) & yazi
End If
yazi = A(i Mod 3, Val(Mid(sayi, Len(sayi) + 1 - i, 1))) & yazi
Next
If Left(yazi, 6) = "birbin" Then yazi = Replace(yazi, "birbin", "bin")
yazi = yazi + " TL. "
If kusurat > 0 Then yazi = yazi + A(2, Val(Left(kusurat, 1))) + A(1, Val(Right(kusurat, 1))) + " Krş."
YazRakam = yazi

End Function