contact@exceltr.com

ExcelTR - Microsoft Excel Eğitim Sitesi

Görsel Video Microsoft Excel Eğitim Sitesi
21 Şub 2012

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

16 % yanıt

  1. aqif

    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. aqif

    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.

    1. GokhanBesnili

      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

  3. GokhanBesnili

    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. GokhanBesnili

      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

Cevap bırakın


7 + 4 =