Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Meslek Gruplarına Yönelik Özel Bölüm => Excel & Muhasebe => Konuyu başlatan: Hüseyin Çoban - 01 Şubat 2011, 17:55:36

Başlık: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: Hüseyin Çoban - 01 Şubat 2011, 17:55:36

Kodları boş bir modüle yapıştırarak uygulayınız.

Kod: [Seç]

Function tlkryaz(Sayi#)
'formül:  =tlkryaz(hücre adresi)
    Dim virgul2 As String
    Dim cevap As String
    Dim yazi As String
    Dim Say As String
    Dim uclu As String
    Dim virgul As Integer
    Dim o As Integer
    Dim b As Integer
    Dim x As Integer
    Dim i As Integer
    Dim y As Integer
    Dim TL As String
    Dim KR As String
   
    If Sayi# = 0 Then tlkryaz = "Sıfır": Exit Function
   
    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 = ""
   
    'AŞAĞIDAKİ 2 SATIRDAKİ ÇİFT TIRNAK İÇERİĞİNİ DEĞİŞTİREREK
    'VEYA ÇİFT TIRNAĞIN ARASINI SİLEREK    "" VEYA "," GİBİ
    'İSTEĞİNİZ SONUCUN ÇIKMASINI SAĞLAYABİLİRSİNİZ.
    TL = ".-TL., "
    KR = ".-KR."

    Say = Str$(Sayi#)
    virgul = InStr(1, Say, ".")
    If virgul Then
       
        'Aşağadaki satır 26,4  Yirmialtı TL, KIRK KR olarak okutur.
        '              (Yirmialtı TL, DÖRT KR olarak değil)
        'İptal etmek isterseniz başına bir  ' tek tırnak işareti koyunuz
        If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
       
        Say = Right$(Say, Len(Say) - virgul)
        GoSub cevir
       
        If cevap = "" Then KR = ""
        virgul2 = cevap + KR
        cevap = ""
       
        Say = Str$(Sayi#)
        Say = Left$(Say, virgul - 1)
    End If
    GoSub cevir
    If cevap = "" Then TL = ""
    tlkryaz = cevap + TL + 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
     If Sayi# < 0 Then cevap = "-Eksi-" + cevap
     Return
End Function


Formül:

Kod: [Seç]

=tlkryaz(hücre adresi)

Alıntı...

Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: assenucler - 29 Eylül 2012, 22:02:07

Sayın Hüseyin Çoban,


İyi akşamlar.
Emek ve paylaşımınız için teşekkürler.

Yazının başına "Yalnız" sözcüğü konulabilir mi? Örneğin, "Yalnızİkiyüzlira" gibi...

Sevgi ve saygılar.

Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: Bülent Öztürk - 30 Eylül 2012, 11:58:15

Merhaba Selim Bey,

Kodları şu şekilde uyarlayabiliriz:

Kod: [Seç]

Function tlkryaz(Sayi#)
'formül:  =tlkryaz(hücre adresi)
    Dim virgul2 As String
    Dim cevap As String
    Dim yazi As String
    Dim Say As String
    Dim uclu As String
    Dim virgul As Integer
    Dim o As Integer
    Dim b As Integer
    Dim x As Integer
    Dim i As Integer
    Dim y As Integer
    Dim TL As String
    Dim KR As String
   
    If Sayi# = 0 Then tlkryaz = "Sıfır": Exit Function
   
    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 = ""
   
    'AŞAĞIDAKİ 2 SATIRDAKİ ÇİFT TIRNAK İÇERİĞİNİ DEĞİŞTİREREK
    'VEYA ÇİFT TIRNAĞIN ARASINI SİLEREK    "" VEYA "," GİBİ
    'İSTEĞİNİZ SONUCUN ÇIKMASINI SAĞLAYABİLİRSİNİZ.
    TL = ".-TL., "
    KR = ".-KR."

    Say = Str$(Sayi#)
    virgul = InStr(1, Say, ".")
    If virgul Then
       
        'Aşağadaki satır 26,4  Yirmialtı TL, KIRK KR olarak okutur.
        '              (Yirmialtı TL, DÖRT KR olarak değil)
        'İptal etmek isterseniz başına bir  ' tek tırnak işareti koyunuz
        If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
       
        Say = Right$(Say, Len(Say) - virgul)
        GoSub cevir
       
        If cevap = "" Then KR = ""
        virgul2 = cevap + KR
        cevap = ""
       
        Say = Str$(Sayi#)
        Say = Left$(Say, virgul - 1)
    End If
    GoSub cevir
    If cevap = "" Then TL = ""
    tlkryaz = cevap + TL + virgul2
    tlkryaz = "Yalnız " & tlkryaz
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
     If Sayi# < 0 Then cevap = "-Eksi-" + cevap
     Return
     
End Function



Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: assenucler - 30 Eylül 2012, 19:59:38

Sayın Bülent Öztürk,


Değerli üstadım, iyi akşamlar. Dinlence gününüzde zaman ayırarak verdiğiniz yanıt için içten teşekkürlerimi sunarım.

Sevgi ve saygılar.

Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: Hüseyin Çoban - 30 Eylül 2012, 20:41:34

. . .

Merhaba,  Bülent Bey çözümü sunmuş. Alternatif olarakta aşağıdaki şekilde de olabilir.

İlk mesajdaki kodlar için

Kod: [Seç]

="Yalnız "&tlkryaz(A1)
. . .

Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: ysntr - 15 Kasım 2014, 14:06:01

"Katrilyon" nasıl ekleriz

Başlık: Ynt: Excel'de Rakamı Yazıya Çevirmek 2 ( .-TL., .-KR. ) (KTF)
Gönderen: ergenekon45 - 26 Şubat 2016, 14:37:46

Sayın Hüseyin Çoban,

Emek ve paylaşımınız için teşekkürler.

Bende bu metne dönüşen rakamı yazılırken parantez içine nasıl alınır onu öğrenmek istiyorum
örneğin: "1400,20 (Yalnız Bindörtyüz TL,Yirmi Kr.)"  veya 1400 (Yalnız Bindörtyüz TL) gibi...

Sevgi ve saygılar.