• DİKKAT

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

TCMB Döviz Kuru Listeleme

F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
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

Haluk' Alıntı:
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

.
Genişletmek için tıkla ...

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,
 
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
 
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
 
Sayın evrensngr teşekkür ederim.
Ben xml kodları ile yapmak istiyorum.
 
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:
Halit bey teşekkür ederim.Oldu.
Farklı çözümleride bekliyorum.
 
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
 
Orion1' Alıntı:
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.
Genişletmek için tıkla ...


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

.
 
Haluk hocam.
Teşekkür ederim.
Tamda istediğim buydu.(y)
Teşekkür ederim.
 
Kolay gelsin Evren Bey,

.
 
Haluk hocam;
Bu tabloyu ado ilede alabilrmiyiz?
 
Orion1' Alıntı:
Haluk hocam;
Bu tabloyu ado ilede alabilrmiyiz?
Genişletmek için tıkla ...

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.

.
 
Haluk' Alıntı:
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.

.
Genişletmek için tıkla ...
Anladım hocam.
Birde ado ile nasıl olur görebilseydim iyi olacaktı.Acaba bunun için bir kod yazarmısınız?
 
Forumda, Zeki Beyin bu tür enteresan çalışmaları vardı diye hatırlıyorum ....

.
 
Anladım hocam.Bir bakayım,görürsem arşivime alırım.
Teşekkür ederim.İyi günler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst