Tarihe Göre Tcmb Döviz Kuru Alma

Tarihe Göre Tcmb Döviz Kuru Alma

  • Konuyu başlatan Konuyu başlatan PriveT
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
PriveT

PriveT

İlyas PINAROĞLU

Yönetici
Kullanıcı
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Sayın Makro üstadlarım merhaba,
Forumumuzda henüz bulunmayan bir konu. Bir çok kişinin de işine yarayacağını düşünüyorum.

Belirtilecek tarihlere ait TCMB kurlarını çekecek bir KTF makrosu hazırlayabilir misiniz?

Çalışma prensibi şu şekilde olmasını istiyorum;
Herhangibir hücreye, hatta bir çok hücreye tarih yazacağız.
Örneğin A5 hücresine bir tarih yazdık.
Herhangibir hücreye =euro(A5) yazdığımızda o tarihin euro kurunu, =usd(A5) yazdığımızda o tarihin usd kurunu getirsin.

Şimdiden teşekkürler, kolay gelsin.
 
Listedeki Cariye Göre Fiyat Getirme
XML Dosyası Oluşturma
Tarihe göre sırala Oylamaya göre sırala
Formül olarak kullanılan biçiminde tarih olarak resmi tatil olmayan bir günün tarihini yazarak bir dener misiniz?
A1 hücresine 24.05.2019 gibi haftaiçi olan bir günün tarihini yazarsanız =WebDoviz(A1;B3;1) gibi yazılarak kullanılan formül hata vermez.
Formüldeki A1 yerine aşağıdaki formül parçasını yazarak, ilgili tarih haftasonu ise bundan önceki son cuma tarihinin kuru alınabilir
Kod: 
$A$1-ARA(HAFTANINGÜNÜ($A$1;2);{1;6;7};{0;1;2})
 
Oyla 0 Olumsuz oyla
Alternatif olsun, sayfa üzerinde parça al ile yapmış olduğum çalışma.
EURO
Kullanımı =euro(tarih)
VBA: 
Function euro(gun As Date) As Variant
    Set XD = CreateObject("microsoft.xmlhttp")
    If Weekday(CDate(gun), vbMonday) = 6 Then gun = CDate(gun - 1)
    If Weekday(CDate(gun), vbMonday) = 7 Then gun = CDate(gun - 2)
Basa_Don:
        trh = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")
            XD_URL = "https://www.tcmb.gov.tr/kurlar/" & trh & ".xml"
                XD.Open "get", XD_URL, False
                XD.send
                    gethttp = XD.responseText
deg1 = Split(XD.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
gun = gun - 1
GoTo Basa_Don
End If
End If
                        ea = InStr(1, gethttp, "EUR") 'Euro alış
                        euroa = Mid(gethttp, ea + 121, 6)
    If Not IsNumeric(euroa) Then euro = "Bulunamadı.": Exit Function
    euro = euroa
End Function

USD
Kullanımı =usd(tarih)
VBA: 
Function usd(gun As Date) As Variant
    Set XD = CreateObject("microsoft.xmlhttp")
    If Weekday(CDate(gun), vbMonday) = 6 Then gun = CDate(gun - 1)
      If Weekday(CDate(gun), vbMonday) = 7 Then gun = CDate(gun - 2)
Basa_Don:
        trh = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")
            XD_URL = "https://www.tcmb.gov.tr/kurlar/" & trh & ".xml"
                XD.Open "get", XD_URL, False
                XD.send
                    gethttp = XD.responseText
deg1 = Split(XD.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
gun = gun - 1
GoTo Basa_Don
End If
End If
                        da = InStr(1, gethttp, "USD") 'Dolar alış
                        dolara = Mid(gethttp, da + 132, 6)
    If Not IsNumeric(dolara) Then usd = "Bulunamadı.": Exit Function
    usd = dolara
End Function
Alternatif 3:
ullanımı =KurGetir(Tarih,Cinsi)
VBA: 
Function KurGetir(gun As Date, cins As Range) As Variant
    Set XD = CreateObject("microsoft.xmlhttp")
    If Weekday(CDate(gun), vbMonday) = 6 Then gun = CDate(gun - 1)
    If Weekday(CDate(gun), vbMonday) = 7 Then gun = CDate(gun - 2)
Basa_Don:
        trh = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")
            XD_URL = "https://www.tcmb.gov.tr/kurlar/" & trh & ".xml"
                XD.Open "get", XD_URL, False
                XD.send
                    gethttp = XD.responseText
deg1 = Split(XD.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
gun = gun - 1
GoTo Basa_Don
End If
End If
                        If StrConv(cins, 1) = StrConv("usd", 1) Then
                            da = InStr(1, gethttp, "USD") 'Dolar alış
                            dolara = Mid(gethttp, da + 132, 6)
                                If Not IsNumeric(dolara) Then KurGetir = "Bulunamadı.": Exit Function
                                KurGetir = dolara
                        End If
                        If StrConv(cins, 1) = StrConv("euro", 1) Then
                            ea = InStr(1, gethttp, "EUR") 'Euro alış
                            euroa = Mid(gethttp, ea + 121, 6)
                                If Not IsNumeric(euroa) Then KurGetir = "Bulunamadı.": Exit Function
                                KurGetir = euroa
                        End If
End Function
 
Oyla 0 Olumsuz oyla
12.nolu mesajda (benim 1.cevabım) ki kodlar güncellenmiştir. Hafta Sonu tarihleri için düzeltme yapılmıştır. Resmi tatiller için çalışma yapılacak. :)
 
Oyla 0 Olumsuz oyla
Sayın @Feyzullah emeğinize sağlık.
Geçmişte ben de bir miktar ilgilenmiştim bu konuyla ama, zamanında net'ten bilgi çekme konusunda edindiğim tecrübe yeterli gelmemişti ve olay soğudu gitti.

Malumdur TC. Merkez Bankası sayfasında yabancı para kur bilgileriyle ilgili iki alan var;
-- Gösterge Niteliğindeki Merkez Bankası Kurları << İlgili Sayfa
USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD, NOK, SAR, JPY, BGN, RON, RUB, IRR, CNY, PKR, QAR
-- Alım Satıma Konu Olmayan Dövizlere İlişkin Bilgi Amaçlı Kurlar << İlgili Sayfa
ARS, ALL, AZN, BHD, AED, BAM, BRL, CZK, IDR, PHP, ZAR, KRW, GEL, INR, HRK, HKD, IQD, ISK, KZT, QAR, HUF, MKD, MYR, MXN, EGP, UZS, PEN, PLN, SGD, SYP, THB, TMT, UAH, JOD, ILS, NZD

Madem bu işe el attınız; bence hücreye yazılacak formül şeklinde kullanımı olan KTF'de;
-- tarih kontrolü olacak (dini bayramları dahil etmek sıkıntılı olabilir ancak en azından milli bayram ve haftasonu kontrolü olabilir),
-- belirttiğim iki kaynakta bulunan yabancı para türlerinin tümünü içerecek
-- kur türünü (döviz/efektif alış/satış) de seçimli hale getirecek (tabi ilk grupta bazılarına ait iki, bazılarına ait 4, ikinci grupta ise 1 kur türü var)
-- bu KTF'de, tıpkı yerleşik işlevlerde olduğu gibi formül unsurları için ipucu-açıklama gibi eklemeler de olacak şekilde bir yapı oluştrursanız,
(bu konuda şurada örnek var >> wellsr.com/vba/2017/excel/vba-macrooptions-to-add-udf-description/)
EKLENTİ haline getirilip tüm belgelerde kullanmaya müsait bir KTF ortaya çıkartmış olursunuz ve tüm üyeler için çok faydalı olur diye düşünüyorum.
 
Oyla 0 Olumsuz oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst