TCMB Döviz Kuru Listeleme

fledermaus

Altın Üye
Katılım
18 Kasım 2012
Mesajlar
394
Excel Vers. ve Dili
Microsoft Office 365
Merhaba,

Ekte göndemiş olduğum dosyadan yenile tuşunu kullanarak TCMB'dan liste başlıklarına dayalı olarak kurları nasıl çekebilirim ?

Konuyla alaklaı yardım olaibilirseniz çok sevinirim.

Saygılarımla,
 

Ekli dosyalar

fledermaus

Altın Üye
Katılım
18 Kasım 2012
Mesajlar
394
Excel Vers. ve Dili
Microsoft Office 365
Aşağıdaki linkte, geçmiş döneme ait kurların alınmasına ilişkin kullanıcı tanımlı fonksiyonların olduğu dosyalar var..... Tüm mesajları okuyup, uygun olanını seçersiniz.

https://www.excel.web.tr/threads/tc-merkez-bankasi-doeviz-kurlari-alinmasi-xml.174388/#post-951838

.
Tekrar Merhaba,

Paylaşmış olduğunuz örnekleri inceledim. Fakat verilen örnekler belirli bir tarih için ve birçok para birimi için kullanılabiliyor. Ayrıca çapraz kurlar dahil değil. Benim yapmak istediğim, listemde paylaşmış olduğum başlık ve belirtecek olduğum tarihlere istinaden datalar olacak.


Saygılarımla,
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Haluk hocam merhaba.
Aşağıdaki kodlar ile abd doları ve japon yenini set mylist satırında kodları yazıp verileri almak istiyorum.
Yapamadım.
Nasıl yapmalıyım?
Kod:
Sub XMLDosyasiniOku()
    'Haluk
    '06/08/2018
    
    Dim XDoc As Object, strURL As String
    Dim myList As Object
    Dim Num As Byte
    
    Range("A2:G100") = ""

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    XDoc.Load strURL
    Set myList = XDoc.SelectNodes("Tarih_Date/Currency[dc:creator='USD']")
    MsgBox myList.Length
    If myList.Length = 0 Then GoTo SafeExit:
    Num = myList.Length - 1
    For i = 0 To Num
        Cells(i + 2, 1) = i + 1
        Cells(i + 2, 2) = myList(i).ChildNodes(0).Text
        Cells(i + 2, 3) = myList(i).ChildNodes(1).Text
        Cells(i + 2, 4) = myList(i).ChildNodes(3).Text
        Cells(i + 2, 5) = myList(i).ChildNodes(4).Text
        Cells(i + 2, 6) = myList(i).ChildNodes(5).Text
        Cells(i + 2, 7) = myList(i).ChildNodes(6).Text
    Next
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing

MsgBox "bitti"
End Sub
 

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
Private Sub CommandButton1_Click()
Dim s As Long
Dim ie, t
[A2:E10] = ""
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "http://www.tcmb.gov.tr/kurlar/today.xml"
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop
Set st = ie.document.getElementById("kurlarContainer")
On Error Resume Next
For Each t In st.getElementsByTagName("*")
If Trim(t.Children(0).innertext) = "USD/TRY" Or Trim(t.Children(0).innertext) = "EUR/TRY" _
Or Trim(t.Children(0).innertext) = "GBP/TRY" Then
s = Cells(Rows.Count, 1).End(3).Row + 1
Cells(s, 1) = t.Children(0).innertext
Cells(s, 2) = t.Children(3).innertext
Cells(s, 3) = t.Children(4).innertext
Cells(s, 4) = t.Children(5).innertext
Cells(s, 5) = t.Children(6).innertext
End If
Next
Set st = Nothing
ie.Quit
End Sub

Bu Kodları Kullanarak Çekebilirsiniz Or Kullanarak Sitede yazan adıyla kuru aynı alıp farklı kurlarda ekleyebilirsiniz
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Sayın evrensngr teşekkür ederim.
Ben xml kodları ile yapmak istiyorum.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bunu bir dene

Rich (BB code):
Sub XMLDosyasiniOku()

Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False
XDoc.validateOnParse = False
XDoc.Load ("http://www.tcmb.gov.tr/kurlar/today.xml")
Set myList = XDoc.DocumentElement
Set List = XDoc.SelectNodes("//Currency")

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
URL1 = ("http://www.tcmb.gov.tr/kurlar/today.xml")
xmlhttp.Open "GET", URL1, False
xmlhttp.send "at"

say = 2
deg1 = Split(xmlhttp.responseText, "Kod")

For i = 0 To List.Length - 2
deg2 = Split(deg1(i + 1), " ")
If UBound(deg2) > 0 Then
kurr = Replace(Replace(deg2(0), "=", ""), """", "")
End If

aranan = Array("EUR", "JPY")

For t = 0 To UBound(aranan)
If aranan(t) = kurr Then
Cells(say, 1) = say - 1
Cells(say, 2) = myList.ChildNodes(i).ChildNodes(0).Text
Cells(say, 3) = kurr
Cells(say, 4) = myList.ChildNodes(i).ChildNodes(1).Text
Cells(say, 5) = myList.ChildNodes(i).ChildNodes(3).Text
Cells(say, 6) = myList.ChildNodes(i).ChildNodes(4).Text
Cells(say, 7) = myList.ChildNodes(i).ChildNodes(5).Text
Cells(say, 8) = myList.ChildNodes(i).ChildNodes(6).Text
say = say + 1
End If
Next t

Next

MsgBox "işlem tamam"
End Sub
 
Son düzenleme:

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Halit bey teşekkür ederim.Oldu.
Farklı çözümleride bekliyorum.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhaba.
Haluk beyin kodlarında kırmızı yeri yapıncada oldu,ama ben döngüde değilde set mylist satırında yapmak istiyorum.
Rich (BB code):
Sub XMLDosyasiniOku()
    'Haluk
    '06/08/2018
    
    Dim XDoc As Object, strURL As String
    Dim myList As Object
    Dim Num As Byte
    
    Range("A2:H100") = ""

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    XDoc.Load strURL
    Set myList = XDoc.SelectNodes("//Currency")
    If myList.Length = 0 Then GoTo SafeExit:
    Num = myList.Length - 1
    sat = 2
    For i = 0 To Num
        ulke = myList(i).ChildNodes(1).Text
        If ulke = "ABD DOLARI" Or ulke = "JAPON YENİ" Or ulke = "İSVİÇRE FRANGI" Then
            Cells(sat, 1) = i + 1
            Cells(sat, 2) = myList(i).ChildNodes(0).Text
            Cells(sat, 3) = myList(i).ChildNodes(1).Text
            Cells(sat, 4) = myList(i).ChildNodes(3).Text
            Cells(sat, 5) = myList(i).ChildNodes(4).Text
            Cells(sat, 6) = myList(i).ChildNodes(5).Text
            Cells(sat, 7) = myList(i).ChildNodes(6).Text
            sat = sat + 1
        End If
    Next
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing

MsgBox "bitti"
End Sub
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,268
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Merhaba.
Haluk beyin kodlarında kırmızı yeri yapıncada oldu,ama ben döngüde değilde set mylist satırında yapmak istiyorum.

Evren Bey, aşağıdaki gibi deneyin....

Kod:
    Set myList = XDoc.SelectNodes("//Currency[CurrencyName='US DOLLAR' or CurrencyName='JAPENESE YEN']")

Yani, kodun tamamı aşağıdaki gibi olmalı...

Kod:
Sub XMLDosyasiniOku_HD()
    'Haluk
    '06/08/2018 - 13/05/2019
    '
    Dim XDoc As Object, strURL As String
    Dim myList As Object
    Dim Num As Byte
   
    Range("A2:G100") = ""

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    XDoc.Load strURL
    Set myList = XDoc.SelectNodes("//Currency[CurrencyName='US DOLLAR' or CurrencyName='JAPENESE YEN']")
    If myList.Length = 0 Then GoTo SafeExit:
    Num = myList.Length - 1
    For i = 0 To Num
        Cells(i + 2, 1) = i + 1
        Cells(i + 2, 2) = myList(i).ChildNodes(0).Text
        Cells(i + 2, 3) = myList(i).ChildNodes(1).Text
        Cells(i + 2, 4) = myList(i).ChildNodes(3).Text
        Cells(i + 2, 5) = myList(i).ChildNodes(4).Text
        Cells(i + 2, 6) = myList(i).ChildNodes(5).Text
        Cells(i + 2, 7) = myList(i).ChildNodes(6).Text
    Next
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing
MsgBox "bitti"
End Sub
.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Haluk hocam.
Teşekkür ederim.
Tamda istediğim buydu.(y)
Teşekkür ederim.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,268
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Kolay gelsin Evren Bey,

.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Haluk hocam;
Bu tabloyu ado ilede alabilrmiyiz?
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,268
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Haluk hocam;
Bu tabloyu ado ilede alabilrmiyiz?
Evren Bey, bu mesajınız gözümden kaçmış....

Ben şöyle düşünüyorum; bu işi, yani sorgulama işini yapabilmek için ilk önce söz konusu XML tablosundaki verileri bir ADO Recordset nesnesine yazdırdıktan sonra yapabilirsiniz.

Diğer yandan; bilgisayarda zaten esas sürenin gerekli ADO bağlantısını kurmak için harcandığını ve elimizde zaten hazır bir XML tablosu olduğunu düşünürsek, bunun yerine yukarıda olduğu gibi XML tablosundan XPATH kullanarak bu işleri çok daha hızlı yapmak en doğru çözüm olacaktır.

.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Evren Bey, bu mesajınız gözümden kaçmış....

Ben şöyle düşünüyorum; bu işi, yani sorgulama işini yapabilmek için ilk önce söz konusu XML tablosundaki verileri bir ADO Recordset nesnesine yazdırdıktan sonra yapabilirsiniz.

Diğer yandan; bilgisayarda zaten esas sürenin gerekli ADO bağlantısını kurmak için harcandığını ve elimizde zaten hazır bir XML tablosu olduğunu düşünürsek, bunun yerine yukarıda olduğu gibi XML tablosundan XPATH kullanarak bu işleri çok daha hızlı yapmak en doğru çözüm olacaktır.

.
Anladım hocam.
Birde ado ile nasıl olur görebilseydim iyi olacaktı.Acaba bunun için bir kod yazarmısınız?
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,268
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Forumda, Zeki Beyin bu tür enteresan çalışmaları vardı diye hatırlıyorum ....

.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Anladım hocam.Bir bakayım,görürsem arşivime alırım.
Teşekkür ederim.İyi günler.
 
Üst