• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarihe Göre TCMB Döviz Kuru Aldırma

Katılım
9 Haziran 2010
Mesajlar
1
Excel Vers. ve Dili
2003 türkçe
Merhaba Arkadaşlar,
Sahibi olduğum şirkette teklif formatı kullanıyoruz. Teklif formatında USD,EURO ve TL olarak alış fiyatlarını girdiğim bir bölüm var buraya girdiğim rakamları Teklifi verdiğim döviz cinsine göre otomatik çevirip teklifi öyle hazırlıyor. Ancak bunu yaparken USD ve EURO kurlarını elle her seferinde girmem gerekiyor. TCMB den çekmeyi denedim fakat buda her excele girişte otomatik kur çektiği için teklifin fiyatlarında bozulmalara sebebiyet veriyor. Teklifi oluşturduğum bir tarih alanıda var bu tarih alalında ki tarihi baz alarak sadece o günün kurunu çekmesi mümkünmüdür ?
 
Merhaba,

Aşağıdaki KTF'yi deneyin.

Kullanımı,

Kod:
=kur(A1)

yada

=kur("30.06.2018")


Kod:
Function kur(veri As Date)
Application.Volatile

Set dnm = CreateObject("MSXML2.XMLHTTP")

gun = veri - 1

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")

baglan = "http://www.tcmb.gov.tr/kurlar/" & a & ".xml"
'baglan = "http://www.tcmb.gov.tr/kurlar/today.xml"

dnm.Open "get", baglan, False
  dnm.send
 icerik$ = dnm.responseText
temizlik = Split(icerik, "<Currency CrossOrder="): a = 1
icerik$ = ""
On Error Resume Next
cr = IsError(InStr(temizlik(1), "</CurrencyName>"))

gun = gun - 1
Loop While cr = ""
x = 2


sonuclar = Split(temizlik(1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), "<ForexBuying>")

Sonuc = VBA.Left(sonuclar1(1), 6)

kur = CDbl(Replace(Sonuc, ".", ","))

End Function
 
Son düzenleme:
Yukarida kuvari nickli arkadasimizin onerisi muhtemelen isinizi gorecektir.

Ancak; TCMB gunluk ve gecmise yonelik doviz ve efektif kurlarini XML tablosu olarak yayinlamakta oldugundan, istenilen verileri uygun bir kodlama ile daha hizli ve rahat/guvenilir bir sekilde elde etmek mumkundur.

Boyle bir dosya isterseniz, ucreti karsiliginda verebilirim.

https://drive.google.com/open?id=1Zcpk5SNpZ77nRRSvOMSV1ZHm1tLGDcTd

.
 
Son düzenleme:
Merhaba,

Aşağıdaki KTF'yi deneyin.

Kullanımı,

Kod:
=kur(A1)

yada

=kur("30.06.2018")


Kod:
Function kur(veri As Date)
Application.Volatile

Set dnm = CreateObject("MSXML2.XMLHTTP")

gun = veri - 1

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")

baglan = "http://www.tcmb.gov.tr/kurlar/" & a & ".xml"
'baglan = "http://www.tcmb.gov.tr/kurlar/today.xml"

dnm.Open "get", baglan, False
  dnm.send
icerik$ = dnm.responseText
temizlik = Split(icerik, "<Currency CrossOrder="): a = 1
icerik$ = ""
On Error Resume Next
cr = IsError(InStr(temizlik(1), "</CurrencyName>"))

gun = gun - 1
Loop While cr = ""
x = 2


sonuclar = Split(temizlik(1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), "<ForexBuying>")

Sonuc = VBA.Left(sonuclar1(1), 6)

kur = CDbl(Replace(Sonuc, ".", ","))

End Function

Erdem_34 üstadım paylaşım için teşekkürler. Acaba bu kodu diğer döviz türleri için de kullanmak istenirse kodum hangi bölümü değiştirilmeli acaba !
 
Merhaba Sayın @baydeniro .
SAyın @Erdem_34 şu an çevrimiçi değil.

-- Hangi yabancı para sorusunun cevabı aşağıda kırmızı renklendirdiğim sayı (TCMB'nin kur sayfasında listedeki sıra numarası, EURO için 4 gibi).
-- Kur çeşidi için ise; Forex (Döviz), Efektif (Banknote), Alış(Buying), Satış(Selling) kısımlarında değişiklik yapabilirsiniz.
sonuclar = Split(temizlik(1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), "<ForexBuying>")
 
Kodu biraz genişlettim. Üç döviz cinsi(Usd, Eur, Gbp) için sorgu yapılabiliyor. Döviz Kurlarını da tablodaki dört seçeneğe(Döviz Alış, Döviz Satış, Efektif Alış, Efektif Satış) göre sorgulayabilirsiniz.
=Kur("08.10.2019;"Usd";"Döviz Alış")


Kod:
Function Kur(veri As Date, DovizCinsi As Variant, DovizKuru As Variant)

Application.Volatile
'-----------Ben ekledim-------------------



        If DovizCinsi = "Usd" Then
            DovizCinsi = 1
        ElseIf DovizCinsi = "Eur" Then
            DovizCinsi = 4
        ElseIf DovizCinsi = "Gbp" Then
            DovizCinsi = 5
        End If


        If DovizKuru = "Döviz Alış" Then
            DovizKuru = "<ForexBuying>"
        ElseIf DovizKuru = "Döviz Satış" Then
            DovizKuru = "<ForexSelling>"
        ElseIf DovizKuru = "Efektif Alış" Then
            DovizKuru = "<BanknoteBuying>"
        ElseIf DovizKuru = "Efektif Satış" Then
            DovizKuru = "<BanknoteSelling>"
        End If

    '----------------------------------------

Set dnm = CreateObject("MSXML2.XMLHTTP")

gun = veri - 1

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")

baglan = "http://www.tcmb.gov.tr/kurlar/" & a & ".xml"
'baglan = "http://www.tcmb.gov.tr/kurlar/today.xml"

dnm.Open "get", baglan, False
  dnm.send
icerik$ = dnm.responseText
temizlik = Split(icerik, "<Currency CrossOrder="): a = 1
icerik$ = ""
On Error Resume Next
cr = IsError(InStr(temizlik(DovizCinsi * 1), "</CurrencyName>"))

gun = gun - 1
Loop While cr = ""
'x = 2


sonuclar = Split(temizlik(DovizCinsi * 1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), DovizKuru)

Sonuc = VBA.Left(sonuclar1(1), 6)


Kur = CDbl(Replace(Sonuc, ".", ","))

End Function
 
hata veriyor.deger bulamıyor.Kur fonksiyonu geliyor ancak deger cekemiyor
 
TCMB' nin sayfasında değişiklikler oldu. Sanırım bu yüzden hata veriyor. Değişiklikleri güncelledim ama ne yaptıysam olmadı.
 
http yazan yerleri https olarak değiştirin.
 
Kodu biraz genişlettim. Üç döviz cinsi(Usd, Eur, Gbp) için sorgu yapılabiliyor. Döviz Kurlarını da tablodaki dört seçeneğe(Döviz Alış, Döviz Satış, Efektif Alış, Efektif Satış) göre sorgulayabilirsiniz.
=Kur("08.10.2019;"Usd";"Döviz Alış")


Kod:
Function Kur(veri As Date, DovizCinsi As Variant, DovizKuru As Variant)

Application.Volatile
'-----------Ben ekledim-------------------



        If DovizCinsi = "Usd" Then
            DovizCinsi = 1
        ElseIf DovizCinsi = "Eur" Then
            DovizCinsi = 4
        ElseIf DovizCinsi = "Gbp" Then
            DovizCinsi = 5
        End If


        If DovizKuru = "Döviz Alış" Then
            DovizKuru = "<ForexBuying>"
        ElseIf DovizKuru = "Döviz Satış" Then
            DovizKuru = "<ForexSelling>"
        ElseIf DovizKuru = "Efektif Alış" Then
            DovizKuru = "<BanknoteBuying>"
        ElseIf DovizKuru = "Efektif Satış" Then
            DovizKuru = "<BanknoteSelling>"
        End If

    '----------------------------------------

Set dnm = CreateObject("MSXML2.XMLHTTP")

gun = veri - 1

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & Replace(CStr(gun), ".", "")

baglan = "http://www.tcmb.gov.tr/kurlar/" & a & ".xml"
'baglan = "http://www.tcmb.gov.tr/kurlar/today.xml"

dnm.Open "get", baglan, False
  dnm.send
icerik$ = dnm.responseText
temizlik = Split(icerik, "<Currency CrossOrder="): a = 1
icerik$ = ""
On Error Resume Next
cr = IsError(InStr(temizlik(DovizCinsi * 1), "</CurrencyName>"))

gun = gun - 1
Loop While cr = ""
'x = 2


sonuclar = Split(temizlik(DovizCinsi * 1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), DovizKuru)

Sonuc = VBA.Left(sonuclar1(1), 6)


Kur = CDbl(Replace(Sonuc, ".", ","))

End Function


Merhaba, bu çalışmıyor yardımcı olabilecek var mı?
 
#11 nolu mesajdaki düzeltmeyi uyguladınız mı?

Ayrıca profilinizdeki excel versiyon bilgisini düzeltmenizi rica edeceğim.
 
Merhaba,

Aşağıdaki gibi çalıştırabildim, ancak hafta sonuna denk gelen günde donuyor, bağlanamıyor. sorun nedir acaba ?

Kod:
Function kur(veri As Date)
Application.Volatile
Set dnm = CreateObject("MSXML2.XMLHTTP")
gun = veri - 1

gun2 = Format(Day(gun), "0#") & Format(Month(gun), "0#") & Year(gun)

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & gun2

baglan = "https://www.tcmb.gov.tr/kurlar/" & a & ".xml"


dnm.Open "get", baglan, False
  dnm.send
 icerik$ = dnm.responseText
temizlik = Split(icerik, "<Currency CrossOrder="): a = 1
icerik$ = ""
On Error Resume Next
cr = IsError(InStr(temizlik(1), "</CurrencyName>"))

gun = gun - 1
Loop While cr = ""
x = 2

sonuclar = Split(temizlik(1), "</CurrencyName>")
sonuclar1 = Split(sonuclar(1), "<BanknoteSelling>")

Sonuc = VBA.Left(sonuclar1(1), 6)

kur = CDbl(Replace(Sonuc, ".", ","))

'kur = baglan

End Function
 
Farklı eklemeler yapmışsınız bence bu satırları öncelikle kontrol edin.
Kod:
gun2 = Format(Day(gun), "0#") & Format(Month(gun), "0#") & Year(gun)

Do

a = Year(gun) & Format(Month(gun), "0#") & "/" & gun2
 
Orijinal hali ile çalışmıyorki normal veri olan tarihlerde sorun yok, veri olmayan tarih olduğunda tarihten 1 çıkararak işlem yapması gerekiyor ancak bu uygulama çalışmıyor.
 
Alternatif;

Harici Link (Silinebilir) ; https://we.tl/t-BnLu9XUmpk

KTF kullanımı;

=TCMB_KURU(Para_Birimi;Tarih;Kur_Tipi)

Kur_Tipi parametresinde aşağıdaki ifadeler kullanılmalıdır,

DA - Döviz Alış
DS - Döviz Satış
EA - Efektif Alış
ES - Efektif Satış

Örnek kullanımlar;

=TCMB_KURU("EURO";"01.04.2020";"DA")
=TCMB_KURU("ABD DOLARI";"15.04.2020";"EA")
=TCMB_KURU("ABD DOLARI";BUGÜN();"EA")
 

Ekli dosyalar

hiçbir dosyayı indiremiyorum :) Altınüye olmamı istiyor :(
 
#17 nolu mesajıma harici link eklenmiştir.
 
Geri
Üst