• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
299
Excel Vers. ve Dili
microsoft office professional plus 2016
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
 
Son düzenleme:
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"
 
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
 
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
 
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.

Kod: 
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
 
Teşekkür

necdet bey size bu çalışmayı yapan arkadaşınıza teşekkürler elinize sağlık iyi çalışmalar
 
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.
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst