Kullanıcı Tanımlı Fonksiyon "SAYIOKU()"
Gönderilme zamanı: 02 May 2023, 21:43
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