Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Excel'e Yeni Başlayanlar
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Excel'e Yeni Başlayanlar Excel kullanmaya yeni başladıysanız sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 05-12-2017, 12:10   #1
KMLZDMR
Altın Üye
 
Giriş: 09/04/2015
Şehir: ANKARA
Mesaj: 278
Excel Vers. ve Dili:
2003 TÜRKÇE EXCEL
Varsayılan VB deki modül adını excel hücresinden seçerek formül içinde oluşturabilmek için...

Merhaba,
VB deki modülünde rakamı usd,euro,ytl,tl olarak çeviren bir fonksiyon var.
excel L47 hücresinde bu fonksiyonların adları var: seçerek formül içinde oluşturabilmek için...

P47 HÜCRESİNDEKİ FORMÜL P42 hücresindeki rakamı =EĞER(P42=0;"";"-#- "&yazusd(P42)&" -#-") olarak çalışmaktadır.Yani rakamı yazıya çeviriyor.

Ancak, yapmak istediğim ise L47 hücresinde liste halinde YAZUSD;YAZEUR;YAZTL;YAZYTL;YAZ; seçimleri bulunmaktadır.

P47 hücresindeki formülde örneğin yazusd yerine L47 yi hangi formüller yazarsak (=EĞER(P42=0;"";"-#- "&L47(P42)&" -#-"))
bize =EĞER(P42=0;"";"-#- "&yazusd(P42)&" -#-") yazmış gibi sonuç vermesi gerekli. Amacım, L47 de USD,EURO,YTL,TL ye çevirmek istediğimde bir yerden değişiklik yapabilmektir.
Teşekkür ederim.


Visual Basic Düzenleyicideki fonksiyon aşağıdadır. (ayrıca bu fonksiyon TL ye çevirmede Kuruş değerini bende çevirmedi. Nasıl düzeltilir.

'YazYTL(Para) , YazEUR(Para) , YazUSD(Para) foksiyon sayıyı yazıya çevirme

Public Function Yaz(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
Yaz = IIf(Para < 0, "Eksi ", "") & Cevir(TL)
Exit Function
SayiDegil:
Yaz = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazTL(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
YazTL = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL"
Exit Function
SayiDegil:
YazTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Public Function YazYTL(Para)
Dim ParaStr As String
Dim YTL As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
YTL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If YTL = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " KURUŞ"
Else
If Kurus = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL."
Else
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL." & Cevir(Kurus) & "-YENİ KURUŞ."
End If
End If
Exit Function
SayiDegil:
YazYTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazEUR(Para)
Dim ParaStr As String
Dim EUR As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
EUR = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If EUR = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR."
Else
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazEUR = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazUSD(Para)
Dim ParaStr As String
Dim USD As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
USD = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If USD = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD."
Else
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazUSD = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
Birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
Onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
Binler = Array("TRİLYON", "MİLYAR", "MİLYON", "BİN", "")
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 = "BİRBİN") Then e = "BİN"
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "00"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
KMLZDMR Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2017, 12:43   #2
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,283
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

Aşağıdaki fonksiyonu eski bir dosyamda buldum, sizin işinize yarayabilir.

P42 hücresinde yer alan değeri yazdırmak için kullanımı;

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
=YazPara(P42;"USD")
veya, para birimleri L47 hücresindeyse; (TL, YTL, USD, EUR)

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
=YazPara(P42;L47)
Aşağıdakileri bir modüle yerleştirip, fonksiyonu yukarıda verdiğim örneklerdeki gibi kullanın.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
' ****************************************************************************
' * Bu kodlar http://www.excel.gen.tr/?s=2.1&k=75 adresinden indirilmiş olan *
' * comma.xls dosyasından alınmış olup gerekli düzenlemeler yapılmıştır.     *
' * Kodların kullanımı sonucunda oluşacabilecek hatalar ve tüm sorumluluk    *
' * kullanıcıya aittir.                                                      *
' *                                                                          *
' *                              Haluk ®                                     *
' *                             Eylul 2004                                   *
' * **************************************************************************

Function YazPara(ByVal Sayi, Birim As String)

    Dim Lira, Kurus, Temp
    Dim Basamak, Say
    
    Select Case Birim
        Case "TL"
            Birim1 = "TL"
            Birim2 = "Kuruş"
        Case "YTL"
            Birim1 = "YTL"
            Birim2 = "Yeni Kuruş"
        Case "EUR"
            Birim1 = "EUR"
            Birim2 = "Cent"
        Case "USD"
            Birim1 = "USD"
            Birim2 = "Cent"
    End Select

    ReDim Hane(9) As String
    Hane(2) = " Bin "
    Hane(3) = " Milyon "
    Hane(4) = " Milyar "
    Hane(5) = " Trilyon "

    Sayi = Trim(Str(Sayi))

    Basamak = InStr(Sayi, ".")
    
    If Basamak > 0 Then
        Kurus = Onlar(Left(Mid(Sayi, Basamak + 1) & "00", 2))
        Sayi = Trim(Left(Sayi, Basamak - 1))
    End If

    Say = 1
    Do While Sayi <> ""
       Temp = Yuzler(Right(Sayi, 3))
       If Temp <> "" Then Lira = Temp & Hane(Say) & Lira
          If Len(Sayi) > 3 Then
             Sayi = Left(Sayi, Len(Sayi) - 3)
        Else
            Sayi = ""
        End If
        Say = Say + 1
    Loop

    Select Case Lira
        Case ""
            Lira = "Sıfır " & Birim1
        Case "Bir"
            Lira = "Bir " & Birim1
        Case Else
            Lira = Lira & " " & Birim1
    End Select
    
    Lira = WorksheetFunction.Substitute(Lira, "Bir Bin", "Bin", 1)
    Lira = WorksheetFunction.Substitute(Lira, "Bir Yüz", "Yüz", 1)

    Select Case Kurus
        Case ""
            Kurus = " ve Sıfır " & Birim2
        Case "One"
            Kurus = " ve Bir " & Birim2
        Case Else
            Kurus = " ve " & Kurus & " " & Birim2
    End Select

    YazPara = Lira & Kurus
End Function
'
Function Yuzler(ByVal Sayi)
    Dim Result As String

    If Val(Sayi) = 0 Then Exit Function
    Sayi = Right("000" & Sayi, 3)

    If Mid(Sayi, 1, 1) <> "0" Then
        Result = Rakkam(Mid(Sayi, 1, 1)) & " Yüz "
    End If

    If Mid(Sayi, 2, 1) <> "0" Then
        Result = Result & Onlar(Mid(Sayi, 2))
    Else
        Result = Result & Rakkam(Mid(Sayi, 3))
    End If

    Yuzler = Result
End Function
'
Function Onlar(OnlarBasamak)
    Dim Result As String

    Result = ""
    If Val(Left(OnlarBasamak, 1)) = 1 Then
        Select Case Val(OnlarBasamak)
            Case 10: Result = "On"
            Case 11: Result = "Onbir"
            Case 12: Result = "Oniki"
            Case 13: Result = "Onüç"
            Case 14: Result = "Ondört"
            Case 15: Result = "Onbeş"
            Case 16: Result = "Onaltı"
            Case 17: Result = "Onyedi"
            Case 18: Result = "Onsekiz"
            Case 19: Result = "Ondokuz"
            Case Else
        End Select
      Else
        Select Case Val(Left(OnlarBasamak, 1))
            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 & Rakkam(Right(OnlarBasamak, 1))
      End If
      Onlar = Result
   End Function
'
Function Rakkam(Deger)
    Select Case Val(Deger)
        Case 1: Rakkam = "Bir"
        Case 2: Rakkam = "İki"
        Case 3: Rakkam = "Üç"
        Case 4: Rakkam = "Dört"
        Case 5: Rakkam = "Beş"
        Case 6: Rakkam = "Altı"
        Case 7: Rakkam = "Yedi"
        Case 8: Rakkam = "Sekiz"
        Case 9: Rakkam = "Dokuz"
        Case Else: Rakkam = ""
    End Select
End Function
__________________
Kod anlatılmaz,yazılır ! 🇹🇷

Bu mesaj en son " 05-12-2017 " tarihinde saat 12:52 itibariyle Haluk tarafından düzenlenmiştir....
Haluk Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2017, 18:34   #3
KMLZDMR
Altın Üye
 
Giriş: 09/04/2015
Şehir: ANKARA
Mesaj: 278
Excel Vers. ve Dili:
2003 TÜRKÇE EXCEL
Varsayılan

teşekkür ederim.
KMLZDMR Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-12-2017, 19:14   #4
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,283
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

Kolay gelsin ...

.
__________________
Kod anlatılmaz,yazılır ! 🇹🇷
Haluk Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 06:56


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden