Para Ceviri Sayiyi Yaziya Cevirme Uygulamasi


Ornek resimde gibi rakamlari yahut tutarlari yaziyla yazabilmeniz icin bir uygulama ornegi paylasiyorum, cok fazla detayina ve anlatimina gecmicem cunku bu konuda istekleriniz olabilecegini dusunuyorum, bunlari yaparken bir taraftanda anlatmis olurum saniryorum..

Kodlarimiz;

Function yaziyla(sayi)

On Error Resume Next

Dim deg(3), s(3), deger(2)

a = Array("", "bir", "iki", "üç", "dört", "bes", "alti", "yedi", "sekiz", "dokuz")

b = Array("", "on", "yirmi", "otuz", "kirk", "elli", "altmis", "yetmis", "seksen", "doksan")

c = Array("", "", "bin", "milyon", "milyar", "trilyon")

deger(1) = Int(sayi)

deger(2) = Round(sayi - deger(1), 2) * 100

If sayi = 0 Then son = "sifir"

For g = 1 To 2

yazi = deger(g)

For d = 1 To Len(yazi) Step 3

e = e + 1

deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)

deg(2) = Mid(yazi, Len(yazi) - d, 1)

deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)

If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "yüz", "biryüz", "yüz")

s(2) = b(deg(2))

s(3) = a(deg(3)) & c(e)

If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""

son = s(1) & s(2) & s(3) & son

If Left(son, 6) = "birbin" Then son = Replace(son, "birbin", "bin")

For f = 1 To 3

deg(f) = ""

s(f) = ""

Next: Next

If g = 1 And deger(1) <> 0 Then TL = StrConv(son, vbProperCase) & " TL"

If g = 2 And deger(2) <> 0 Then Kr = " " & StrConv(son, vbProperCase) & " Kr"

son = ""

e = 0

Next

yaziyla = TL & Kr

End Function

Bir alternatif fonksiyon daha;

Option Explicit

Function SpellNumber(ByVal MyNumber, _
                  Optional pbNum As Boolean = True, _
                  Optional ptCur As String = "Pound", _
                  Optional ptDec As String = "Pence", _
                  Optional ptPlu As String = "")

Dim Curr, Decm, Temp
Dim DecimalPlace, Count
Dim vtPHolder As String

    ReDim Place(9) As String
    Place(2) = "Thousand"
    Place(3) = "Million"
    Place(4) = "Billion"
    Place(5) = "Trillion"

    '' String representation of amount
    MyNumber = Trim(Str(MyNumber))
 
    '' Position of decimal place 0 if none
    DecimalPlace = InStr(MyNumber, ".")
    '' Convert decimal part, and set MyNumber to currency amount
    If DecimalPlace > 0 Then
        vtPHolder = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
        If pbNum = True Then
            Decm = GetTens(vtPHolder)
        Else
            Decm = vtPHolder
        End If
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
 
    Count = 1
    Do While MyNumber <> ""
       Temp = GetHundreds(Right(MyNumber, 3))
       If Temp <> "" Then Curr = Temp & Place(Count) & Curr
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
 
    Select Case Curr
        Case ""
            Curr = " No " & ptCur & "s"
        Case "One"
            Curr = " One " & ptCur
        Case Else
            Curr = Curr & " " & ptCur & "s"
    End Select
 
    Select Case Decm
        Case ""
            'Decm = " No " & ptDec & ptPlu
        Case "One", "01"
            Decm = " and " & Decm & " " & ptDec
        Case Else
            Decm = " and " & Decm & " " & ptDec & ptPlu
    End Select
 
    SpellNumber = Curr & Decm
End Function
 
'*******************************************
' Converts a number from 100-999 into text *
'*******************************************
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
 
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
 
    'Convert the hundreds place
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & "Hundred"
    End If
 
    'Convert the tens and ones place
    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
 
'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Function GetTens(TensText)
    Dim Result As String

    Result = ""                                         'null out the temporary function value
    If Val(Left(TensText, 1)) = 1 Then                  'If value between 10-19
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
      Else                                              'If value between 20-99
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty"
            Case 3: Result = "Thirty"
            Case 4: Result = "Forty"
            Case 5: Result = "Fifty"
            Case 6: Result = "Sixty"
            Case 7: Result = "Seventy"
            Case 8: Result = "Eighty"
            Case 9: Result = "Ninety"
            Case Else
        End Select
         Result = Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place
      End If
      GetTens = Result
End Function
 
'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function

Ornek dosyayi inceleyiniz..

Rakami Yaziya

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

“Para Ceviri Sayiyi Yaziya Cevirme Uygulamasi” için 16 yorum

  1. selamun aleykum
    arkadaşlar acemi soru için kusura bakmayın, ekli dosya nasıl kullanılır? Office 2007 kullanıram. yani .rar formatdan çıkardığımda 3 klasör ve bi de dosya geliyor. bunu nasıl kullanıcam? lütfen yardım edermisiniz…
    teşekkürler…

  2. Merhaba Mustafa bey
    o zaman şöyle deyim, bir dosya indiriyorum, peki onu excelde nasıl açabilirim. import veya eklentidenmi acaba? üzerine 2 kez tıklayınca arşiv dosyası gibi içine girip deyişik klasörler gösteriyor.

  3. Bahsettiginiz dosyayi paylasma luksunuz var ise yardimci olayim fakat elinizdeki dosyanin ne oldugunu bilemiyorum, bizim paylastigimiz bir dosya degil sanirim.

     

  4. Bu konudaki dosyada sadece bir xlsm dosyasi mevcut, dosya direkt olarak excelde aciliyor zaten, her hangi bir arsiv programi calistirmaz.

    Ekran goruntusu var mi cok garip bir durum!

  5. hocam sorunu çözdüm. kaydet dediyimde .zip gibi kaydoluyor. formatı .xlsm yaptığımda düzeldi. teşekkür ederim, zamanınızı çaldım.

    1. Akif bey

      Merhaba, bende söz konusu dosyayı sıkışturılmış dosya olarak indiriliyor. Siz xlsm dosyasına nasıl dönüştürdünüz. Bu bir virüs olabilir mi. Çünkü dosyayı aç dediğimde doğrudan winzip kur ekranı geliyor ve 29.usd ödeme istiyor. Tşk

  6. mustafa bey merhaba

    excelde cari tutmak istiiyorum fakat formulleri yapamıyorum yardımcı olabilirmisiniz

  7. Mustafa bey

    Merhaba, söz konusu fonksiyon YAZIYLA mıdır.? Benim bilgisayarımdaki excel de bu fonskiyon yok. Söz konusu fonksiyonu yeni mi yaratıyor olmamız lazım.

    Tşk

    1. Mustafa bey

      Ben sorunumu çözdüm, teşk.ler. Visual basic yoluyla fonksiyon yarattım. Ancak tabiki sizin yazdığınız formulleri aynen kopyalarak yazdım. 🙂 Çok tşkler

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


7 + 8 =