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,406
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
42,235
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. :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst