TCMB Döviz Kuru Listeleme

fledermaus · 13 Mayıs 2019

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,

Haluk · 13 Mayıs 2019

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

.

fledermaus · 13 Mayıs 2019

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

.

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 · 13 Mayıs 2019

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 · 13 Mayıs 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 · 13 Mayıs 2019

Sayın evrensngr teşekkür ederim.
Ben xml kodları ile yapmak istiyorum.

evrensngr · 13 Mayıs 2019

Orion1' Alıntı:
Sayın evrensngr teşekkür ederim.
Ben xml kodları ile yapmak istiyorum.

MyListi arttırmayı denediniz mi

Orion1 · 13 Mayıs 2019

evrensngr' Alıntı:
MyListi arttırmayı denediniz mi

Denemedim.
Nasıl olacak?Yazdığım kodlara ilave yazarmısınız?

evrensngr · 13 Mayıs 2019

Orion1' Alıntı:
Denemedim.
Nasıl olacak?Yazdığım kodlara ilave yazarmısınız?

Hemen deneyip örnek dosya ile atıcam size

halit3 · 13 Mayıs 2019

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

Orion1 · 13 Mayıs 2019

Halit bey teşekkür ederim.Oldu.
Farklı çözümleride bekliyorum.

Orion1 · 13 Mayıs 2019

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 · 13 Mayıs 2019

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.

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 · 13 Mayıs 2019

Haluk hocam.
Teşekkür ederim.
Tamda istediğim buydu.

Teşekkür ederim.

Haluk · 14 Mayıs 2019

Kolay gelsin Evren Bey,

.

Orion1 · 14 Mayıs 2019

Haluk hocam;
Bu tabloyu ado ilede alabilrmiyiz?

Haluk · 16 Mayıs 2019

Orion1' Alıntı:
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 · 16 Mayıs 2019

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.

.

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

Haluk · 16 Mayıs 2019

Forumda, Zeki Beyin bu tür enteresan çalışmaları vardı diye hatırlıyorum ....

.

Orion1 · 16 Mayıs 2019

Anladım hocam.Bir bakayım,görürsem arşivime alırım.
Teşekkür ederim.İyi günler.

TCMB Döviz Kuru Listeleme

fledermaus

Ekli dosyalar

Haluk

Özel Üye

fledermaus

Orion1

Uzman

evrensngr

Orion1

Uzman

evrensngr

Orion1

Uzman

evrensngr

halit3

Uzman

Orion1

Uzman

Orion1

Uzman

Haluk

Özel Üye

Orion1

Uzman

Haluk

Özel Üye

Orion1

Uzman

Haluk

Özel Üye

Orion1

Uzman

Haluk

Özel Üye

Orion1

Uzman