İki fonksiyonu birleştirmek

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Esenlikler Arkadaşlar;
Aşağıdaki fonksiyonlarla girilen rakamı yazıya çeviriyorum
Yalnız ikinci fonkisyonu, birin fonkisyona ilave edip

Function Yazıyla_Rakam

Go sub cevir (tamsayı)
..........

Go sub cevir (ondalık)

Exit Function
cevir:
............
Retun
End sub
Genişletmek için tıkla ...
şeklinde kullanmak istiyorum ama mantığını anlamadığım için yapamadım yardımlarınızı esirgemezseniz sevinirim.
Örnek yazımlar
=Yazıyla_Rakam(C19)
=Yazıyla_Rakam(E19;"kg";"gram";3;"false")
=Yazıyla_Rakam(G19;"kg";"gram";5;"true")


Function Yazıyla_Rakam(Sayı, Optional TBirim = "YTL", Optional ABirim = "YKR", _
Optional OnUzun = 2, Optional OnSis As Boolean = False)
'###################################################################################################
'######### Bir rakamı yazı ile yazar. #########
'######### İster para, ister metre veya ondalık sistemde #########
'######### yazabilmeniz için yeniden düzenlenmiştir. #########
'######### Hsayar - 03/03/2008 #########
'###################################################################################################
'Sayı : Bir Sayı Giriniz
'TBirim : Virgülden önceki kısmın Ölçü cinsi (Ytl, Kg, Metre... vs)
'ABirim : Virgülden sonraki kısmın Ölçü cinsi (Ykr, g, cm... vs)
'OnUzun : Virgülden sonra dikkate alınacak rakam sayısı _
(Paralar için = 2, kilolar için = 3 vs...)
'OnSis : Eğer Onluk sistemdeki gibi yazacaksanız "True" veya 1 _
mesala 15,25 = "Onbeş tam yüzde yirmibeş" gibi.
Dim ParaStr$, OnFrm$, Lira$, Kurus$
Dim ArrOran() As Variant
Dim i&

If Not IsNumeric(Sayı) Then
Yazıyla_Rakam = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If
OnFrm = "0."
For i = 1 To OnUzun: OnFrm = OnFrm & "0": Next i
ParaStr = Format(Abs(Sayı), OnFrm)

Lira = Left(ParaStr, Len(ParaStr) - (OnUzun + 1)): Kurus = Right(ParaStr, OnUzun)
If OnSis = True Then
ArrOran = Array("", ", Onda ", ", Yüzde ", ", Binde ", _
", Onbinde ", ", Yüzbinde ", ", Milyonda ", _
", OnMilyonda ", ", YüzMilyonda ", ", Milyarda ", _
", OnMilyarda ", ", YüzMilyarda ", ", Trilyonda ", _
", OnTrilyonda ", ", YüzTrilyonda ")
TBirim = "Tam"
If Val(Kurus) <> 0 Then TBirim = TBirim & ArrOran(OnUzun)
ABirim = ""
Erase ArrOran
End If

Yazıyla_Rakam = IIf(Sayı < 0, "Eksi ", "") & Trim(cevir(Lira)) & " " & TBirim & " " & _
IIf(Val(Kurus) <> 0, cevir(Kurus) & " " & ABirim & " ", "")

ParaStr = "": OnFrm = "": Lira = "": Kurus = "": i = 0
Erase ArrOran()
End Function
Genişletmek için tıkla ...
Private Function cevir(SayiStr As String) As String
Dim Rakam(15) As Variant, c(3) As Variant
Dim Birler() As Variant, onlar() As Variant, Binler() As Variant
Dim Sonuc$, e$, i&

Birler = Array("", "bir ", "iki ", "üç ", "dört ", "beş ", "altı ", "yedi ", "sekiz ", "dokuz ")
onlar = Array("", "on ", "yirmi ", "otuz ", "kırk ", "elli ", "altmış ", "yetmiş ", "seksen ", "doksan ")
Binler = Array("trilyon ", "milyar ", "milyon ", "bin ", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz "
Else
e = Birler(c(1)) + "yüz "
End If
e = e + onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "bir bin ") Then e = "bin "
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "00"
cevir = UpperTr(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
Erase Rakam(): Erase c()
Erase Birler(): Erase onlar(): Erase Binler()
Sonuc = "": e = "": i = 0
End Function
Genişletmek için tıkla ...
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sorun çözüldü;

Kod: 
Option Explicit           'Değişken tanımlamak zorunludur
Function FncHsr_Yaziyla_Rakam(Sayı, Optional TBirim = "YTL", Optional ABirim = "YKR", _
                             Optional OnUzun = 2, Optional OnSis As Boolean = False)
'#########################################################################################################'
'#########################################################################################################'
'#########         Bir rakamı yazı ile yazar.                                                    #########'
'#########         İster para, ister metre veya  ondalık sistemde                                #########'
'#########         yazabilmeniz için yeniden düzenlenmiştir.                                     #########'
'#########         [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL] nin katkılarıyla                                             #########'
'#########         Hsayar - 03/03/2008                                                           #########'
'#########         28/08/2008 tarihinde Cevir Fonksiyonu, mevcut fonksiyonla birleştirildi.      #########'
'========================================================================================================='
'Sayı               : Bir Sayı Giriniz                                                           \     '||'
'TBirim             : Virgülden önceki  kısmın Ölçü cinsi (Ytl, Kg, Metre... vs)                  \    '||'
'ABirim             : Virgülden sonraki kısmın Ölçü cinsi (Ykr, g, cm... vs)                       \   '||'
'OnUzun             : Virgülden sonra dikkate alınacak rakam sayısı _                               \  '||'
'                      (Paralar için = 2, kilolar için = 3 vs...)                                    \ '||'
'OnSis              : Eğer Onluk sistemdeki gibi yazacaksanız "True" veya 1 _                         \'||'
'                     mesala 15,25 = "Onbeş tam yüzde yirmibeş" gibi.                                  '||'
'#########################################################################################################'
'#########################################################################################################'
    Dim ParaStr$, OnFrm$, Lira$, Kurus$, LiraY$, KurusY$, Sonuc$, e$, SayiStr$                         '||'
    Dim i&                                                                                             '||'
    Dim ArrOran() As Variant, Rakam(15) As Variant, c(3) As Variant                                    '||'
    Dim Birler()  As Variant, Onlar() As Variant, Binler()  As Variant                                 '||'
'Girilen değerin sayı olup olmadığını kontrol et                                                       '||'
    If Not IsNumeric(Sayı) Then                                                                        '||'
        FncHsr_Yaziyla_Rakam = "GİRİLEN DEĞER SAYI DEĞİL!"                                             '||'
        Exit Function                                                                                  '||'
    End If                                                                                             '||'
    Birler = Array("", "bir ", "iki ", "üç ", "dört ", "beş ", "altı ", "yedi ", "sekiz ", "dokuz ")   '|/'
    Onlar = Array("", "on ", "yirmi ", "otuz ", "kırk ", "elli ", "altmış ", "yetmiş ", _
                  "seksen ", "doksan ")                                                                '||'
    Binler = Array("trilyon ", "milyar ", "milyon ", "bin ", "")                                       '|/'
    ArrOran = Array("", ", Onda ", ", Yüzde ", ", Binde ", _
                            ", Onbinde ", ", Yüzbinde ", ", Milyonda ", _
                            ", OnMilyonda ", ", YüzMilyonda ", ", Milyarda ", _
                            ", OnMilyarda ", ", YüzMilyarda ", ", Trilyonda ", _
                            ", OnTrilyonda ", ", YüzTrilyonda ")                                       '||'
    OnFrm = "0."                                                                                       '||'
'Sayıya format ver                                                                                     '||'
    For i = 1 To OnUzun                                                                                '||'
        OnFrm = OnFrm & "0"                                                                            '||'
    Next i                                                                                             '||'
'Değerleri ata                                                                                         '||'
    ParaStr = Format(Abs(Sayı), OnFrm)                                                                 '||'
    Lira = Left(ParaStr, Len(ParaStr) - (OnUzun + 1))                                                  '||'
    Kurus = Right(ParaStr, OnUzun)                                                                     '||'
    If OnSis = True Then                                                                               '||'
        TBirim = "Tam":     ABirim = ""                                                                '||'
        If Val(Kurus) <> 0 Then TBirim = TBirim & ArrOran(OnUzun)                                      '||'
    End If                                                                                             '||'
'Alt prosodürden değerleri al geri dön                                                                 '||'
    SayiStr = Lira:     GoSub cevir:     LiraY = Sonuc                                                 '||'
    SayiStr = Kurus:    GoSub cevir:     KurusY = Sonuc                                                '|/'
'Sonucu yaz
    FncHsr_Yaziyla_Rakam = IIf(Sayı < 0, "Eksi ", "") & Trim(LiraY) & " " & TBirim & " " & _
                    IIf(Val(Kurus) <> 0, Trim(KurusY) & " " & ABirim & " ", "")                        '||'
'Değerleri sıfırla                                                                                     '||'
    ParaStr = "":   OnFrm = "":     Lira = "":      Kurus = ""                                         '||'
    LiraY = "":     KurusY = "":    Sonuc = "":     e = ""                                             '||'
    SayiStr = ""                                                                                       '||'
    i = 0                                                                                              '||'
    Erase ArrOran():        Erase Rakam():          Erase c()                                          '||'
    Erase Birler():         Erase Onlar():     Erase Binler()                                          '||'
Exit Function                                                                                          '||'
'Alt prosodürü işlet                                                                                   '||'
cevir:                                                                                                 '||'
    SayiStr = String(15 - Len(SayiStr), "0") + SayiStr                                                 '||'
    For i = 1 To 15                                                                                    '||'
      Rakam(i) = Val(Mid$(SayiStr, i, 1))                                                              '||'
    Next i                                                                                             '||'
    Sonuc = ""                                                                                         '||'
    For i = 0 To 4                                                                                     '||'
      c(1) = Rakam(i * 3 + 1)                                                                          '||'
      c(2) = Rakam(i * 3 + 2)                                                                          '||'
      c(3) = Rakam(i * 3 + 3)                                                                          '||'
      If c(1) = 0 Then                                                                                 '||'
        e = ""                                                                                         '||'
      ElseIf c(1) = 1 Then                                                                             '||'
        e = "yüz "                                                                                     '||'
      Else                                                                                             '||'
        e = Birler(c(1)) + "yüz "                                                                      '||'
      End If                                                                                           '||'
      e = e + Onlar(c(2)) + Birler(c(3))                                                               '||'
      If e <> "" Then e = e + Binler(i)                                                                '||'
      If (i = 3) And (e = "bir bin ") Then e = "bin "                                                  '||'
      Sonuc = Sonuc + e                                                                                '||'
    Next i                                                                                             '||'
    If Sonuc = "" Then Sonuc = "00"                                                                    '||'
    Sonuc = UCaseTr(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)                                  '||'
Return                                                                                                 '||'
End Function                                                                                           '||'
'=======================================================================================================//'
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst