TCMB Döviz Kuru Listeleme

fledermaus

Altın Üye
Altın Üye
Katılım
18 Kasım 2012
Mesajlar
214
Beğeniler
0
Excel Vers. ve Dili
ingilizce 2016
#1
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
Altın Üye
Katılım
18 Kasım 2012
Mesajlar
214
Beğeniler
0
Excel Vers. ve Dili
ingilizce 2016
#3
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
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#4
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
 
Katılım
7 Mayıs 2019
Mesajlar
40
Beğeniler
0
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
#5
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
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

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

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
11,835
Beğeniler
915
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
#10
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
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#12
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
7,350
Beğeniler
619
Excel Vers. ve Dili
32 Bit 2010 - İngilizce
#13
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
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

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

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
7,350
Beğeniler
619
Excel Vers. ve Dili
32 Bit 2010 - İngilizce
#17
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
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#18
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
7,350
Beğeniler
619
Excel Vers. ve Dili
32 Bit 2010 - İngilizce
#19
Forumda, Zeki Beyin bu tür enteresan çalışmaları vardı diye hatırlıyorum ....

.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,363
Beğeniler
330
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

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