- 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