Sayıyı metne çevirmek.

gelibolu · 25 Aralık 2019

Selamlar elimde şöyle bir kod var yazılan sayıyı metne çeviriyor. Ancak virgüllü sayıları dikkate almıyor.
Aradığım 18,55 'i onsekiz,ellibeş olarak yazacak bir makro / fonksiyona ihtiyacım var. Saygı ve selamlarımla

not: Module kaydettikten sonra a2 hücresine =yazı(A1) yazdığınızda a1de yazan rakamı yazı ile yazar.

Public Function Yaz?(AA)
Dim AAStr As String
Dim BB As String
If Not IsNumeric(AA) Then GoTo SayiDegil
AAStr = Format(Abs(AA), "0.00")
BB = Left(AAStr, Len(AAStr) - 3)
Yaz? = IIf(AA < 0, "Eksi ", "") & Cevir(BB)
Exit Function
SayiDegil:
Yaz? = "G?R?LEN DE?ER SAYI DE??L!"
End Function
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 = "00"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

Necdet · 25 Aralık 2019

Merhaba,

Forumda çokça örnekleri var.
"Rakamı yazıya çevirmek" olarak arayınız.

Burayı İnceleyiniz

gelibolu · 25 Aralık 2019

Teşekkür ederim Rakam ifadesi ile aratınca ilgili sonuçlar çıktı. Sayın HSAYAR'ın çalışması güzel gözüküyor ama altın üye olmadan maalesef görme imkanı yok.

byfika · 26 Aralık 2019

Merhabalar,
1- Alttaki kodları bir module yazın.
2- Excel sayfasında yazının görülmesi gereken hücreye =SayıCevir(B2; ","; ".") formulü yazın. (Ben örnek olarak rakamı B2 ye yazılacak şekilde yaptım, kendiniz rakamı yazacağınız hücreyi formüle uyarlarsınız.)
Formüle göre örnek verecek olursak.: B2 de rakamla yazan : 14,43
C2 ye formül yazıldığını düşünürsek C2 de yazıyla yazan : Ondört, Kırküç. şeklinde olacak.

HÜCREYE YAZILACAK FORMÜL:
=SayıCevir(B2; ","; ".")

MODÜLE YAZILACAK KOD:
Function SayıCevir(S, Optional SBirim = "B", Optional KBirim = "K")
Dim SStr As String
Dim B As String, K As String
If Not IsNumeric(S) Then
SayıCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If
SStr = Format(Abs(S), "0.00")
B = Left(SStr, Len(SStr) - 3)
K = Right(SStr, 2)
SayıCevir = IIf(S < 0, "Eksi ", "") & Cevir(B) & " " & SBirim & " " & _
IIf(Val(K) <> 0, Cevir(K) & " " & KBirim & " ", "")
End Function
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

gelibolu · 26 Aralık 2019

İlginize çok teşekkür ederim. Evet aradığım buydu. Ancak virgülden sonra iki basamağı yazıyor. Üç basamak yazması İçin neresini düzeltmeliyim ?

hsayar · 27 Şubat 2020

gelibolu' Alıntı:
Teşekkür ederim Rakam ifadesi ile aratınca ilgili sonuçlar çıktı. Sayın HSAYAR'ın çalışması güzel gözüküyor ama altın üye olmadan maalesef görme imkanı yok.

Tam olarak istediğiniz nedir? hangi dosyadan bahsediyorsunuz?

Seyit Tiken · 27 Şubat 2020

Bu şekilde deneyiniz.

hsayar · 27 Şubat 2020

gelibolu' Alıntı:
Teşekkür ederim Rakam ifadesi ile aratınca ilgili sonuçlar çıktı. Sayın HSAYAR'ın çalışması güzel gözüküyor ama altın üye olmadan maalesef görme imkanı yok.

=FncHsr_YazRakam(D1;"kg";"gr";3)
formülünde gr sonra gelen yere 3 yazarsanız ona göre sonuç döner
10,1=> on kg. 100 gr.
10,22 => on kg. 220 gr.
10,333 => On kg Üç yüz otuz üç gr
10,4444 => On kg Dört yüz kırk gr
10,4446=> On kg Dört yüz kırk beş gr
gibi.

Kod:

Function FncHsr_YazRakam(Sayı, Optional TBirim = "TL", Optional ABirim = "KR", _
                             Optional OnUzun = 2, Optional OnSis As Boolean = False)
'#########################################################################################################'
'#########         Bir rakamı yazı ile yazar.                                                    #########'
'#########         İster para, ister metre veya  ondalık sistemde                                #########'
'#########         yazabilmeniz için yeniden düzenlenmiştir.                                     #########'
'#########         www.excel.wTr nin katkılarıyla                                                #########'
'#########         Hsayar - 03/03/2008                                                           #########'
'#########         28/08/2008 tarihinde Cevir Fonksiyonu, mevcut fonksiyonla birleştirildi.      #########'
'#########         27/02/2020 tarihinde opsiyonal ytl/ykr tanımları düzeltildi.                  #########'
'========================================================================================================='
'Sayı               : Bir Sayı Giriniz                                                           \     '##'
'TBirim             : Virgülden önceki  kısmın Ölçü cinsi (Ytl, Kg, Metre... vs)                  \    '##'
'ABirim             : Virgülden sonraki kısmın Ölçü cinsi (Ykr, g, cm... vs)                       \   '##'
'OnUzun             : Virgülden sonra dikkate alınacak rakam sayısı _                               \  '##'
'                      (Paralar için = 2, kilolar için = 3 vs...)                                    \ '##'
'OnSis              : Eğer Onluk sistemdeki gibi yazacaksanız "True" veya 1 _                         \'##'
'                     mesala 15,25 = "Onbeş tam yüzde yirmibeş" gibi.                                  '##'
'========================================================================================================='
    Dim ParaStr$, OnFrm$, Lira$, Kurus$, LiraY$, KurusY$, Sonuc$, e$, SayiStr$                         '##'
    Dim i&                                                                                             '##'
    Dim ArrOran() As Variant, Rakam(15) As Variant, c(3) As Variant                                    '##'
    Dim Birler()  As Variant, Onlar() As Variant, Binler()  As Variant                                 '##'
'Girilen değerin sayı olup olmadığını kontrol et                                                       '##'
    If Not IsNumeric(Sayı) Then                                                                        '##'
        FncHsr_YazRakam = "GİRİLEN DEĞER SAYI DEĞİL!"                                                  '##'
        Exit Function                                                                                  '##'
    End If                                                                                             '##'
    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 ", "")                                       '|/'
    ArrOran = Array("", ", Onda ", ", Yüzde ", ", Binde ", _
                            ", Onbinde ", ", Yüzbinde ", ", Milyonda ", _
                            ", OnMilyonda ", ", YüzMilyonda ", ", Milyarda ", _
                            ", OnMilyarda ", ", YüzMilyarda ", ", Trilyonda ", _
                            ", OnTrilyonda ", ", YüzTrilyonda ")                                       '##'
    OnFrm = "0."                                                                                       '##'
'Sayıya format ver                                                                                     '##'
    For i = 1 To OnUzun                                                                                '##'
        OnFrm = OnFrm & "0"                                                                            '##'
    Next i                                                                                             '##'
'Değerleri ata                                                                                         '##'
    ParaStr = Format(Abs(Sayı), OnFrm)                                                                 '##'
    Lira = Left(ParaStr, Len(ParaStr) - (OnUzun + 1))                                                  '##'
    Kurus = Right(ParaStr, OnUzun)                                                                     '##'
    If OnSis = True Then                                                                               '##'
        TBirim = "Tam":     ABirim = ""                                                                '##'
        If Val(Kurus) <> 0 Then TBirim = TBirim & ArrOran(OnUzun)                                      '##'
    End If                                                                                             '##'
'Alt prosodürden değerleri al geri dön                                                                 '##'
    SayiStr = Lira:     GoSub cevir:     LiraY = Sonuc                                                 '##'
    SayiStr = Kurus:    GoSub cevir:     KurusY = Sonuc                                                '|/'
'Sonucu yaz
    FncHsr_YazRakam = IIf(Sayı < 0, "Eksi ", "") & Trim(LiraY) & " " & TBirim & " " & _
                    IIf(Val(Kurus) <> 0, Trim(KurusY) & " " & ABirim & " ", "")                        '##'
'Değerleri sıfırla                                                                                     '##'
    ParaStr = "":   OnFrm = "":     Lira = "":      Kurus = ""                                         '##'
    LiraY = "":     KurusY = "":    Sonuc = "":     e = ""                                             '##'
    SayiStr = ""                                                                                       '##'
    i = 0                                                                                              '##'
    Erase ArrOran():        Erase Rakam():          Erase c()                                          '##'
    Erase Birler():         Erase Onlar():     Erase Binler()                                          '##'
Exit Function                                                                                          '##'
'Alt prosodürü işlet                                                                                   '##'
cevir:                                                                                                 '##'
    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 = "bir bin ") Then e = "bin "                                                  '##'
      Sonuc = Sonuc + e                                                                                '##'
    Next i                                                                                             '##'
    If Sonuc = "" Then Sonuc = "00"                                                                    '##'
    Sonuc = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)                                  '##'
Return                                                                                                 '##'
End Function                                                                                           '##'

Sayıyı metne çevirmek.

gelibolu

Necdet

Moderatör

gelibolu

byfika

Altın Üye

gelibolu

hsayar

Seyit Tiken

Uzman

hsayar