Sayıyı yazıya çevirme

pitchoute · Çarşamba saat 13:01'de

halit3' Alıntı:
Bu kod ondalık sayıları çevirmiyor örnek 101,52

Şöyle çevirir sanırım;

Kod:

Function SayiyiYaziyaCevir(Sayi As Double) As String
    Dim Birler() As String
    Dim Onlar() As String
    Dim Yuzler() As String
    Dim Result As String
    Dim TamKisim As Long
    Dim OndalikKisim As Double
    Dim OndalikSayi As Integer
    Dim basamak As Integer
    Dim On, Yuz As Integer

    Birler = Split("Bir,İki,Üç,Dört,Beş,Altı,Yedi,Sekiz,Dokuz", ",")
    Onlar = Split("On,Yirmi,Otuz,Kırk,Elli,Altmış,Yetmiş,Seksen,Doksan", ",")
    Yuzler = Split("Yüz,İki Yüz,Üç Yüz,Dört Yüz,Beş Yüz,Altı Yüz,Yedi Yüz,Sekiz Yüz,Dokuz Yüz", ",")
 
    TamKisim = Int(Sayi)
    OndalikKisim = Sayi - TamKisim
   
    If TamKisim = 0 And OndalikKisim > 0 Then
        Result = "Sıfır"
    ElseIf TamKisim = 0 Then
        Result = "Sıfır"
        SayiyiYaziyaCevir = Result
        Exit Function
    Else
        Yuz = Int(TamKisim / 100)
        If Yuz > 0 Then
            Result = Result & Yuzler(Yuz - 1) & " "
            TamKisim = TamKisim - (Yuz * 100)
        End If
     
        On = Int(TamKisim / 10)
        If On > 0 Then
            Result = Result & Onlar(On - 1) & " "
            TamKisim = TamKisim - (On * 10)
        End If
     
        If TamKisim > 0 Then
            Result = Result & Birler(TamKisim - 1)
        End If
    End If
   
    If OndalikKisim > 0 Then
        ' Ondalık kısmı 2 basamağa yuvarlayalım
        OndalikSayi = Round(OndalikKisim * 100)
       
        If OndalikSayi > 0 Then
            Result = Application.Trim(Result) & " Virgül "
           
            On = Int(OndalikSayi / 10)
            If On > 0 Then
                Result = Result & Onlar(On - 1) & " "
                OndalikSayi = OndalikSayi - (On * 10)
            End If
           
            If OndalikSayi > 0 Then
                Result = Result & Birler(OndalikSayi - 1)
            End If
        End If
    End If
 
    SayiyiYaziyaCevir = Application.Trim(Result)
End Function

TL ve KR ayrımı için;

Kod:

Function SayiyiParaYaziyaCevir(Sayi As Double) As String
    Dim Birler() As String
    Dim Onlar() As String
    Dim Yuzler() As String
    Dim Result As String
    Dim TamKisim As Long
    Dim OndalikKisim As Double
    Dim OndalikSayi As Integer
    Dim basamak As Integer
    Dim On, Yuz As Integer
    
    Birler = Split("Bir,İki,Üç,Dört,Beş,Altı,Yedi,Sekiz,Dokuz", ",")
    Onlar = Split("On,Yirmi,Otuz,Kırk,Elli,Altmış,Yetmiş,Seksen,Doksan", ",")
    Yuzler = Split("Yüz,İki Yüz,Üç Yüz,Dört Yüz,Beş Yüz,Altı Yüz,Yedi Yüz,Sekiz Yüz,Dokuz Yüz", ",")
    
    TamKisim = Int(Sayi)
    OndalikKisim = Sayi - TamKisim
    
    If TamKisim = 0 Then
        Result = "Sıfır"
    Else
        Yuz = Int(TamKisim / 100)
        If Yuz > 0 Then
            Result = Result & Yuzler(Yuz - 1) & " "
            TamKisim = TamKisim - (Yuz * 100)
        End If
        
        On = Int(TamKisim / 10)
        If On > 0 Then
            Result = Result & Onlar(On - 1) & " "
            TamKisim = TamKisim - (On * 10)
        End If
        
        If TamKisim > 0 Then
            Result = Result & Birler(TamKisim - 1)
        End If
    End If
    
    If Result <> "" Then
        Result = Application.Trim(Result) & " TL"
    End If
    
    If OndalikKisim > 0 Then
        OndalikSayi = Round(OndalikKisim * 100)
        
        If OndalikSayi > 0 Then
            Dim KurusResult As String
            
            On = Int(OndalikSayi / 10)
            If On > 0 Then
                KurusResult = KurusResult & Onlar(On - 1) & " "
                OndalikSayi = OndalikSayi - (On * 10)
            End If
            
            If OndalikSayi > 0 Then
                KurusResult = KurusResult & Birler(OndalikSayi - 1)
            End If
            
            KurusResult = Application.Trim(KurusResult) & " Kr"
            
            If Result <> "" Then
                Result = Result & " " & KurusResult
            Else
                Result = KurusResult
            End If
        End If
    End If
    
    If Result = "" Then
        Result = "Sıfır TL"
    End If
    
    SayiyiParaYaziyaCevir = Result
End Function

shanex · Çarşamba saat 22:07'de

walabi' Alıntı:
Function yaziyacevir(rakam) Dim grup(5), sayi(10, 3), basamak(5), oku(3) sayi(0, 1) = "": sayi(0, 2) = "": sayi(0, 3) = "" sayi(1, 1) = "YÜZ": sayi(1, 2) = "ON": sayi(1, 3) = "BİR" sayi(2, 1) = "İKİYÜZ": sayi(2, 2) = "YİRMİ": sayi(2, 3) = "İKİ" sayi(3, 1) = "ÜÇYÜZ": sayi(3, 2) = "OTUZ": sayi(3, 3) = "ÜÇ" sayi(4, 1) = "DÖRTYÜZ": sayi(4, 2) = "KIRK": sayi(4, 3) = "DÖRT" sayi(5, 1) = "BEŞYÜZ": sayi(5, 2) = "ELLİ": sayi(5, 3) = "BEŞ" sayi(6, 1) = "ALTIYÜZ": sayi(6, 2) = "ALTMIŞ": sayi(6, 3) = "ALTI" sayi(7, 1) = "YEDİYÜZ": sayi(7, 2) = "YETMİŞ": sayi(7, 3) = "YEDİ" sayi(8, 1) = "SEKİZYÜZ": sayi(8, 2) = "SEKSEN": sayi(8, 3) = "SEKİZ" sayi(9, 1) = "DOKUZYÜZ": sayi(9, 2) = "DOKSAN": sayi(9, 3) = "DOKUZ" basamak(5) = "TRİLYON" basamak(4) = "MİLYAR" basamak(3) = "MİLYON" basamak(2) = "BİN" basamak(1) = "" lira = Int(rakam) kurus = Round(rakam - lira, 2) * 100 If Len(lira) > 15 Then MsgBox ("Bu fonksiyon en fazla 15 haneli sayılar için çalışır.") End End If kalan = lira yaziyacevir = "" For x = 1 To 5 a = 15 - 3 * x If Len(lira) > a Then grup(6 - x) = Int(kalan / 10 ^ a) kalan = kalan - (grup(6 - x) * 10 ^ a) End If Next x If grup(5) > 0 Then oku(1) = Int(grup(5) / 100) baskalan = grup(5) - oku(1) * 100 oku(2) = Int(baskalan / 10) oku(3) = baskalan - oku(2) * 10 yaziyacevir = sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(5) End If If grup(4) > 0 Then oku(1) = Int(grup(4) / 100) baskalan = grup(4) - oku(1) * 100 oku(2) = Int(baskalan / 10) oku(3) = baskalan - oku(2) * 10 yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(4) End If If grup(3) > 0 Then oku(1) = Int(grup(3) / 100) baskalan = grup(3) - oku(1) * 100 oku(2) = Int(baskalan / 10) oku(3) = baskalan - oku(2) * 10 yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(3) End If If grup(2) = 1 Then yaziyacevir = yaziyacevir + "BİN" End If If grup(2) > 1 Then oku(1) = Int(grup(2) / 100) baskalan = grup(2) - oku(1) * 100 oku(2) = Int(baskalan / 10) oku(3) = baskalan - oku(2) * 10 yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(2) End If If grup(1) > 0 Then oku(1) = Int(grup(1) / 100) baskalan = grup(1) - oku(1) * 100 oku(2) = Int(baskalan / 10) oku(3) = baskalan - oku(2) * 10 yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(1) End If yaziyacevir = yaziyacevir + " TL." If kurus > 0 Then oku(2) = 0 If Len(kurus) > 1 Then oku(2) = Int(kurus / 10) End If oku(3) = kurus - oku(2) * 10 yaziyacevir = yaziyacevir + sayi(oku(2), 2) + sayi(oku(3), 3) + " KR." End If End Function

Function yaziyacevir(rakam)
Dim grup(5), sayi(10, 3), basamak(5), oku(3)
sayi(0, 1) = "": sayi(0, 2) = "": sayi(0, 3) = ""
sayi(1, 1) = "Yüz": sayi(1, 2) = "On": sayi(1, 3) = "Bir"
sayi(2, 1) = "İkiYüz": sayi(2, 2) = "Yirmi": sayi(2, 3) = "İki"
sayi(3, 1) = " ÜçYüz ": sayi(3, 2) = "Otuz": sayi(3, 3) = "Üç"
sayi(4, 1) = "DörtYüz": sayi(4, 2) = "Kırk": sayi(4, 3) = "Dört"
sayi(5, 1) = "BeşYüz": sayi(5, 2) = "Elli": sayi(5, 3) = "Beş"
sayi(6, 1) = "AltıYüz": sayi(6, 2) = "Altmış": sayi(6, 3) = "Altı"
sayi(7, 1) = "YediYüz": sayi(7, 2) = "Yetmiş": sayi(7, 3) = "Yedi"
sayi(8, 1) = "SekizYüz": sayi(8, 2) = "Seksen": sayi(8, 3) = "Sekiz"
sayi(9, 1) = "DokuzYüz": sayi(9, 2) = "Doksan": sayi(9, 3) = "dokuz"
basamak(5) = "Trilyon"
basamak(4) = "Milyar"
basamak(3) = "Milyon"
basamak(2) = "Bin"
basamak(1) = ""
lira = Int(rakam)
kurus = Round(rakam - lira, 2) * 100
If Len(lira) > 15 Then
MsgBox ("Bu fonksiyon en fazla 15 haneli sayılar için çalışır.")
End
End If
kalan = lira
yaziyacevir = ""

For x = 1 To 5
a = 15 - 3 * x
If Len(lira) > a Then
grup(6 - x) = Int(kalan / 10 ^ a)
kalan = kalan - (grup(6 - x) * 10 ^ a)
End If

Next x

If grup(5) > 0 Then
oku(1) = Int(grup(5) / 100)
baskalan = grup(5) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(5)
End If

If grup(4) > 0 Then
oku(1) = Int(grup(4) / 100)
baskalan = grup(4) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(4)
End If

If grup(3) > 0 Then
oku(1) = Int(grup(3) / 100)
baskalan = grup(3) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(3)
End If

If grup(2) = 1 Then
yaziyacevir = yaziyacevir + "Bin"
End If

If grup(2) > 1 Then
oku(1) = Int(grup(2) / 100)
baskalan = grup(2) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(2)
End If

If grup(1) > 0 Then
oku(1) = Int(grup(1) / 100)
baskalan = grup(1) - oku(1) * 100
oku(2) = Int(baskalan / 10)
oku(3) = baskalan - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(1)
End If
yaziyacevir = yaziyacevir + " TL."
If kurus > 0 Then
oku(2) = 0
If Len(kurus) > 1 Then
oku(2) = Int(kurus / 10)
End If
oku(3) = kurus - oku(2) * 10
yaziyacevir = yaziyacevir + sayi(oku(2), 2) + sayi(oku(3), 3) + " Kr."
End If
End Function

böyle birşey denedim her rakamın ilk harfi büyük oldu.
her rakam değeri ayrı ayrı boşluklu istenirse tırnak önüne ve sonuna boşluk bırakmak iş görecektir.

Sayıyı yazıya çevirme

pitchoute

shanex