Kullanıcı Tanımlı Fonksiyon "SAYIOKU()"

Cevapla
Seyyar Diyari
Mesajlar: 9
Kayıt: 23 Eki 2020, 15:14
İşletim Sisteminiz: Ubuntu & Windows
LibreOffice Sürümü: 7.1.5.2

Kullanıcı Tanımlı Fonksiyon "SAYIOKU()"

Mesaj gönderen Seyyar Diyari »

Evet arkadaşlar, konu başlığını okuduğunuzda tam da düşündüğünüz gibi verilen sayının Türkçe okunuşunu döndüren kullanıcı tanımlı bir fonksiyon örneği. İngilizce için yapılan bir örneğinden Türkçe'ye çevirdim. Daha önce paylaştığım (ebced) kullanıcı tanımlı fonksiyonun içinde Arapça ve İbranice için de benzetimler bulabilirsiniz. Şuanki haliyle "trilyonlara kadar okuyabiliyor. İyi çalışmalar, eğleniyorsanız da iyi eğlenceler.

Kod: Tümünü seç

Function SAYIOKU(ByVal MyNumber)
    Dim Temp, Spell
    Dim Count
    ReDim Place(9)  As String
    Count = 1
    If Val(MyNumber) = 0 Then
        SAYIOKU = "sıfır"
        Exit Function
    Else
    End If
    Place(2) = "bin "
    Place(3) = "milyon "
    Place(4) = "milyar "
    Place(5) = "trilyon "
    Do While MyNumber <> ""
        If Count = 2 And CDbl(Right(MyNumber, 3)) = 1 Then
            Temp = ""
            Spell = Place(Count) & Spell
        Else
            Temp = GetHundreds(Right(MyNumber, 3))
        End If
        If Temp <> "" Then
            Spell = Temp & " " & Place(Count) & Spell
            Temp = ""
        Else
        End If
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
    SAYIOKU = Trim(Spell)
End Function
Function GetHundreds(ByVal MyNumber)
    Dim Result      As String
    MyNumber = Right("000" & MyNumber, 3)
    If Mid(MyNumber, 1, 1) <> "0" Then
        If CDbl(Mid(MyNumber, 1, 1)) > 1 Then
            Result = GetDigit(Mid(MyNumber, 1, 1)) & " yüz "
        Else
            Result = "yüz "
        End If
    End If
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    GetHundreds = Result
End Function
Function GetTens(TensText)
    Dim Result      As String
    Result = ""
    Select Case Val(Left(TensText, 1))
        Case 1: Result = "on "
        Case 2: Result = "yirmi "
        Case 3: Result = "otuz "
        Case 4: Result = "kırk "
        Case 5: Result = "elli "
        Case 6: Result = "altmış "
        Case 7: Result = "yetmiş "
        Case 8: Result = "seksen "
        Case 9: Result = "doksan "
        Case Else
    End Select
    Result = Result & GetDigit(Right(TensText, 1))
    GetTens = Result
End Function
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "bir"
        Case 2: GetDigit = "iki"
        Case 3: GetDigit = "üç"
        Case 4: GetDigit = "dört"
        Case 5: GetDigit = "beş"
        Case 6: GetDigit = "altı"
        Case 7: GetDigit = "yedi"
        Case 8: GetDigit = "sekiz"
        Case 9: GetDigit = "dokuz"
        Case Else: GetDigit = ""
    End Select
End Function
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: Kullanıcı Tanımlı Fonksiyon "SAYIOKU()"

Mesaj gönderen Hamurcu »

Eline sağlık çok işe yarar bir fonksiyon olmuş.

Yıllar önce de ben yapmıştım benzer bir fonksiyon.

Şuradan ulaşabilirsiniz.

Her iki kodu da inceleyip geliştirebilirsiniz.
Seyyar Diyari
Mesajlar: 9
Kayıt: 23 Eki 2020, 15:14
İşletim Sisteminiz: Ubuntu & Windows
LibreOffice Sürümü: 7.1.5.2

Re: Kullanıcı Tanımlı Fonksiyon "SAYIOKU()"

Mesaj gönderen Seyyar Diyari »

Sizin fonksiyonu da biliyorum hocam; görmüştüm

o ayrı bir şahane...sizin de elinize sağlık.

Faturalara, dekont notlara her işe yarar.
Cevapla