Makro ile TCMB'den çapraz kur bilgisini çekmek

K

kerim.61

Katılım
22 Temmuz 2022
Mesajlar
12
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
25-07-2023
Merhaba arkadaşlar. Forumda @Haluk Bey'in paylaştığı aşağıdaki kodları kullanarak istediğim tarihteki TCMB USD ve EUR kurlarını sorunsuz çekebiliyorum. Bu formüle EUR/USD çapraz kurunu da çekebileceğimiz kodları eklemek istiyorum. Çapraz kurlarda aynı sayfada paylaşıldığı için USD ve EUR satırlarındaki gibi eklemeye çalıştım ancak olmadı. Yardımcı olursanız çok makbule geçer.

Kod: 
Function TCMB_Kur(Tarih As Date, DovTip As String, Tipi As String) As Variant
    'Haluk
    '16/11/2017
    
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    If Tarih = Date Then
        strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    Else
        If Weekday(Tarih, vbMonday) = 6 Then
            Tarih = Tarih - 1
        ElseIf Weekday(Tarih, vbMonday) = 7 Then
            Tarih = Tarih - 2
        End If
        
        myDay = Format(Day(CDate(Tarih + 0)), "00")
        myMonth = Format(CDate(Month(Tarih + 0)), "00")
        myYear = Year(CDate(Tarih + 0))
        
        strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
    End If
    
    xDoc.Load strURL
    
    Set KurListesi = xDoc.DocumentElement
    
    Select Case DovTip
        Case Is = "USD"
            Select Case Tipi
                Case Is = "Döviz Alış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(3).Text
                Case Is = "Döviz Satış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(4).Text
                Case Is = "Efektif Alış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(5).Text
                Case Is = "Efektif Satış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(6).Text
            End Select
        Case Is = "EUR"
            Select Case Tipi
                Case Is = "Döviz Alış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(3).Text
                Case Is = "Döviz Satış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(4).Text
                Case Is = "Efektif Alış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(5).Text
                Case Is = "Efektif Satış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(6).Text
            End Select
    End Select
    
    TCMB_Kur = Replace(RetVal, ".", ",") + 0
End Function
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,398
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Şöyle olabilir .....

Formülde Euro için EUR, İngiliz Pound'u için GBP kullanacaksınız.


Capture.PNG


C#: 
Function TCMB_CaprazKur(Tarih As Date, DovTip As String) As Double
    'Haluk
    '26/09/2022
    
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    If Tarih = Date Then
        strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    Else
        If Weekday(Tarih, vbMonday) = 6 Then
            Tarih = Tarih - 1
        ElseIf Weekday(Tarih, vbMonday) = 7 Then
            Tarih = Tarih - 2
        End If
        
        myDay = Format(Day(CDate(Tarih + 0)), "00")
        myMonth = Format(CDate(Month(Tarih + 0)), "00")
        myYear = Year(CDate(Tarih + 0))
        
        strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
    End If
    
    xDoc.Load strURL
    
    Set KurListesi = xDoc.DocumentElement
    
    If DovTip = "EUR" Then
        RetVal = KurListesi.ChildNodes(3).ChildNodes(8).Text
    ElseIf DovTip = "GBP" Then
        RetVal = KurListesi.ChildNodes(4).ChildNodes(8).Text
    End If
    
    TCMB_CaprazKur = Replace(RetVal, ".", ",") + 0
End Function

.
 
K

kerim.61

Katılım
22 Temmuz 2022
Mesajlar
12
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
25-07-2023
Çok teşekkürler Haluk Bey mükemmel oldu. Emeğinize sağlık.
 
K

kerim.61

Katılım
22 Temmuz 2022
Mesajlar
12
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
25-07-2023
Merhabalar üstatlar
Konu benim olduğu için yeni konu açmadım. Umarım yanlış yapmamışımdır.

Haluk Bey'in yukarıdaki kodlarını kullanarak hazırladığım bir excel dosyam var. Her gün kullanıyorum ve işimi kolaylaştırıyor. Ancak 2-3 gündür dosyada değişiklik yapmamama rağmen kur bilgisini çekememeye başladı. #DEĞER! hatası alıyorum ancak hatanın sebebini bulamıyorum. TCMB'nin kurları yayınladığı sayfanın linki de değişmemiş gördüğüm kadarıyla. Altın üyeliğim bittiği için örnek dosya ekleyemiyorum . Excel doyasındaki kodlar ve görsel ekteki gibidir. Yardımcı olabilirseniz çok sevinirim :)

resimlink.com

excel örnek » ResimLink

excel örnek
resimlink.com resimlink.com


Kod: 
Function TCMB_Kur(Tarih As Date, DovTip As String, Tipi As String) As Variant
    'Haluk
    '16/11/2017
   
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
   
    If Tarih = Date Then
        strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    Else
        If Weekday(Tarih, vbMonday) = 6 Then
            Tarih = Tarih - 1
        ElseIf Weekday(Tarih, vbMonday) = 7 Then
            Tarih = Tarih - 2
        End If
       
        myDay = Format(Day(CDate(Tarih + 0)), "00")
        myMonth = Format(CDate(Month(Tarih + 0)), "00")
        myYear = Year(CDate(Tarih + 0))
       
        strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
    End If
   
    xDoc.Load strURL
   
    Set KurListesi = xDoc.DocumentElement
   
    Select Case DovTip
        Case Is = "USD"
            Select Case Tipi
                Case Is = "Döviz Alış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(3).Text
                Case Is = "Döviz Satış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(4).Text
                Case Is = "Efektif Alış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(5).Text
                Case Is = "Efektif Satış"
                RetVal = KurListesi.ChildNodes(0).ChildNodes(6).Text
            End Select
        Case Is = "EUR"
            Select Case Tipi
                Case Is = "Döviz Alış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(3).Text
                Case Is = "Döviz Satış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(4).Text
                Case Is = "Efektif Alış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(5).Text
                Case Is = "Efektif Satış"
                RetVal = KurListesi.ChildNodes(3).ChildNodes(6).Text
            End Select
    End Select
   
    TCMB_Kur = Replace(RetVal, ".", ",") + 0
End Function

Function TCMB_CaprazKur(Tarih As Date, DovTip As String) As Variant
    'Haluk
    '26/09/2022
   
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
   
    If Tarih = Date Then
        strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    Else
        If Weekday(Tarih, vbMonday) = 6 Then
            Tarih = Tarih - 1
        ElseIf Weekday(Tarih, vbMonday) = 7 Then
            Tarih = Tarih - 2
        End If
       
        myDay = Format(Day(CDate(Tarih + 0)), "00")
        myMonth = Format(CDate(Month(Tarih + 0)), "00")
        myYear = Year(CDate(Tarih + 0))
       
        strURL = "http://www.tcmb.gov.tr/kurlar/" & myYear & myMonth & "/" & myDay & myMonth & myYear & ".xml"
    End If
   
    xDoc.Load strURL
   
    Set KurListesi = xDoc.DocumentElement
   
    If DovTip = "EUR" Then
        RetVal = KurListesi.ChildNodes(3).ChildNodes(8).Text
    ElseIf DovTip = "GBP" Then
        RetVal = KurListesi.ChildNodes(4).ChildNodes(8).Text
    End If
   
    TCMB_CaprazKur = Replace(RetVal, ".", ",") + 0
End Function
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,020
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
https://www.tcmb.gov.tr/kurlar/

İlgili bölümlere koyu fontlu eklemeyi yapıp deneyiniz.
 
K

kerim.61

Katılım
22 Temmuz 2022
Mesajlar
12
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
25-07-2023
Çok teşekkürler denedim ve sorun çözüldü. Bu kadar küçük bir şey olmasını beklemiyordum. :)
 
Ü

Ünsal Koç

Katılım
26 Nisan 2024
Mesajlar
4
Excel Vers. ve Dili
Excel 2016 - 2019
Merhaba,
Burada bahsedilen çapraz kur ve kur kullanımı hakkında bilgi verebilir misiniz
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,020
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ünsal Koç' Alıntı:
Merhaba,
Burada bahsedilen çapraz kur ve kur kullanımı hakkında bilgi verebilir misiniz
Genişletmek için tıkla ...
Yazılan fonksiyon istediğiniz tarihe ait EUR/USD ve GBP/USD çapraz kurlarını almaktadır. Bunun için tasarlanmıştır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst