makro ile altın fiyatlarını alabilir miyiz?

[bafralifatih55]

merhaba arkadaşlar

Altın Fiyatları - Altın Kuru | CEPTETEB

Altın fiyatları, altın kuru ve altın alış/satış fiyatlarına buradan ulaşabilirsin. Sen de CEPTETEB'den altın fiyatları ve işlemlerini hemen gerçekleştir.

www.cepteteb.com.tr

bu sitede yer alan altın alış ve satış fiyatlarını excel'e alabilir miyiz?
şimdiden herkese teşekkürler.

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub Kod()
Range("A:D").ClearContents
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "https://www.cepteteb.com.tr/altin-kurlari"
Do While Not IE.readyState = 4: DoEvents: Loop
Do While IE.busy: DoEvents:  Loop
Set fiyat = IE.Document.getElementById("altinTablo")
For a = 0 To fiyat.Rows.Length - 1
    For b = 0 To fiyat.Rows(a).Cells.Length - 1
        Cells(a + 1, b + 1) = fiyat.Rows(a).Cells(b).innerText
    Next
Next
IE.Quit
Range("A:D").EntireColumn.AutoFit
End Sub

 

[muyat]

Döviz Kurları | CEPTETEB

Güncel döviz kurları ile döviz yatırımlarını CEPTETEB'de değerlendir. Uygun döviz kurlarını öğrenmek & çevirici ile döviz kuru hesaplamalarını yapmak için tıkla!

www.cepteteb.com.tr

Ömer bey bunu da ekleyebilir misiniz.Ben ikisini tek sayfada birleştircem
Anlamadıgım şey şu:
Program yönlendirdiginiz sayfadan tabloyu nasıl buluyor?

 

[ÖmerBey]

Program yönlendirdiginiz sayfadan tabloyu nasıl buluyor?

Bu kodla: IE.Document.getElementById("altinTablo")
Kodların isteğinize göre düzenlenmiş hali aşağıdadır...
Birleştirmeyi de dosyanıza göre siz yaparsınız.
İyi çalışmalar...

Sub Kod()
Range("A:D").ClearContents
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "https://www.cepteteb.com.tr/doviz-kurlari"
Do While Not IE.readyState = 4: DoEvents: Loop
Do While IE.busy: DoEvents:  Loop
Set fiyat = IE.Document.getElementById("dovizTablo")
For a = 0 To fiyat.Rows.Length - 1
    For b = 0 To fiyat.Rows(a).Cells.Length - 1
        Cells(a + 1, b + 1) = fiyat.Rows(a).Cells(b).innerText
    Next
Next
IE.Quit
Range("A:D").EntireColumn.AutoFit
End Sub

 

[Haluk]

Alternatif:

Sub Test()
'   Haluk - 11/03/2020
'   sa4truss@gmail.com
    Dim myURL As String, strConnection As String
    Dim myConnection As Object
   
    myURL = "https://www.cepteteb.com.tr/altin-kurlari"
    strConnection = "URL;" & myURL
    Set myConnection = ActiveSheet.QueryTables.Add(Connection:=strConnection, Destination:=Range("$A$1"))
   
    With myConnection
        .Name = "AltinKurlari"
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .WebSelectionType = xlSpecifiedTables
        .WebTables = 1
        .Refresh BackgroundQuery:=False
    End With
End Sub

.

 

[ÖmerBey]

Haluk Hocam,
Siz konuya dahil olmuşken müsaadenizle konu hakkında bir şey sormak istiyorum.
Yukarıdaki kodları yazmadan önce aşağıdaki kodlarla veri almayı denedim, ancak 08.06.2017 tarihine ait veriler geldi. Bu site ile alakalı bir durum mu, yoksa ben bir yerde hata mı yapıyorum? Bir de siteden kaynaklı bir durumsa bu yöntemde bunu aşma imkanı var mıdır?

Sub Kod()
Set X = CreateObject("MSXML2.XMLHTTP")
Set H = CreateObject("htmlFile")
With X
    .Open "GET", "https://www.cepteteb.com.tr/altin-kurlari", False
    .Send
End With
H.body.innerHTML = X.responseText

Set fiyat = H.getElementById("altinTablo")
For a = 0 To fiyat.Rows.Length - 1
    For b = 0 To fiyat.Rows(a).Cells.Length - 1
        Cells(a + 1, b + 1) = fiyat.Rows(a).Cells(b).innerText
    Next
Next
End Sub

 

[bafralifatih55]

Merhaba,
Deneyiniz...

hocam çok süper olmuş. ancak bu kodu bir projede kullanacağım. şöyle bir şey yapabilir miyiz?
bir hücrede makroya değer olarak gram, yarım veya tam şeklinde değer göndererek bu değerlere ait veriyi getirme şansımız var mı buna ilaveten?
teşekkürler.

 

[Haluk]

Ömer Bey, ilginç durum ama bir esprisi vardır herhalde .... bir ara bakarım.

Bu arada; ekli dosyada başka bir alternatif verilmiş olup, veriler çok daha hızlı alınmaktadır.






.

 

[ÖmerBey]

ilginç durum ama bir esprisi vardır herhalde .... bir ara bakarım.

responseText verisini satır satır sayfaya yazdırıp tek tek baktım tabloda eski veriler yer alıyor, güncel veriler hiç yok. Ama internet explorer kullanınca aynı tablo güncel verilerle geliyor.
Dosyanız da epey hızlı veri alıyor, elinize sağlık ama kodları göremeyince yöntemi de öğrenemedik. Neyse artık kısmetse başka sefere...

 

[ÖmerBey]

bir hücrede makroya değer olarak gram, yarım veya tam şeklinde değer göndererek bu değerlere ait veriyi getirme şansımız var mı buna ilaveten?

Burdaki kastınızı anlayamadım, bu verileri değişkene mi aldırmaktan bahsediyorsunuz?
Biraz daha açıklar mısınız?

 

[Haluk]

Ömer Bey;

Siz IE nesnesi ile "Client" tarafında browser'da render edilmiş verileri çektiğiniz için sorun olmuyor. Muhtemelen sözkonusu sitenin altyapısı, "XMLHTTP" isteği gönderildiğinde, o tip bir response göndermek üzere tasarlanmıştır.

.

 

[Haluk]

Ömer Bey, ilaveten....

Web sayfasındaki söz konusu "Altın" verileri esasında bir "JSon" tablosundan alınıp, web sayfasına yazılıyor.... Ben, web sayfası yerine direkt olarak kaynaktan yani; bu "JSon" tablosundan verileri aldığım için çok hızlı oluyor.

JSon:

https://www.cepteteb.com.tr/services/GetGunlukAltinKur

.

 

[ÖmerBey]

Teşekkürler Haluk Hocam,
Hem açıklamanız hem de hızlı yönteminiz için.
İlave olarak sanırım biraz da Regular expression çalışmam gerekiyor.
Saygılarımla...

 

[EmrExcel16]

@Haluk hocam vermiş olduğunuz bilgi için bende teşekkür ederim, ömer bey'e katılıyorum biraz üzerinde çalışmamız gerekiyor

 

[Haluk]

Evet, ben "JSon" verilerini "Regular Expressions" metodu ve "Split" fonksiyonunu kullanarak ayıkladım. Aslında, "JSon" için yazılmış hazır "Class" modüller var ama ben kendi yazdığım kodları kullanmayı tercih ediyorum. Alternatif olarak; VBA ile birlikte "JScript" kullanarak da veriler ayıklanabilir ama o da sadece 32 Bit Excel'de geçerli, 64 Bit Excel'de onun için de ilave bazı şeyler gerekiyor.

Bu nedenle, herhangi bir ilave "Class" kullanmaya gerek kalmadan hem 32 Bit hem de 64 Bit Excel'de "RegExp" kullanmak bana göre en iyisi...

.

 

[bafralifatih55]

Burdaki kastınızı anlayamadım, bu verileri değişkene mi aldırmaktan bahsediyorsunuz?
Biraz daha açıklar mısınız?

hocam merhaba
projemde bazen gram altın, bazende yarım altın ve diğer çeşitleri hesaplamam gerekiyor. bu yüzden gram altına göre mi yoksa yarım altına göre mi işlem yapmak istediğimi makroya bildirmem gerekiyor. ona görede gram yada yarım altın fiyatı ilgili hücreye düşsün istedim.
teşekkürler.

 

[ÖmerBey]

projemde bazen gram altın, bazende yarım altın ve diğer çeşitleri hesaplamam gerekiyor. bu yüzden gram altına göre mi yoksa yarım altına göre mi işlem yapmak istediğimi makroya bildirmem gerekiyor. ona görede gram yada yarım altın fiyatı ilgili hücreye düşsün istedim.

Bunun için aşağıdaki fonksiyonu kullanabilirsiniz.
Bu fonksiyonu boş bir modüle kopyaladıktan sonra =Altin_Fiyat(1) şeklinde hücrede formül olarak, ya da Altin_Fiyat(1) şeklinde makro kodu içerisinde kullanabilirsiniz.
Kullanabileceğiniz parametreler function içerisinde belirtilmiştir.
Satış fiyatını almak için kodda yer alan Cells(1) ifadesini Cells(2) olarak değiştiriniz.

Function Altin_Fiyat(tur As Byte)
'***tur değerleri***
'1 - Gram Altın
'2 - Çeyrek Altın
'3 - Yarım Altın
'4 - Tam Altın

Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "https://www.cepteteb.com.tr/altin-kurlari"
Do While Not IE.readyState = 4: DoEvents: Loop
Do While IE.busy: DoEvents:  Loop

Set fiyat = IE.Document.getElementById("altinTablo")

Altin_Fiyat = fiyat.Rows(tur).Cells(1).innerText
Altin_Fiyat = CDbl(Replace(Altin_Fiyat, " TL", ""))
IE.Quit
End Function

 

[Haluk]

Ekli alternatif dosyada, "Split" yöntemi kullanılmıştır...

.

 

[ridvansahin]

hocam bu makro çok güzel olmuş . Geliştirilmesinde fayda olacağını düşünüyorum. Döviz kurlarını da alabilir mi?

 

[Haluk]

Ekli dosya ise; 8 No'lu ve devamındaki mesajlarda bahsedilen "Regular Expressions" tekniğiyle verilerin alınmasını içerir...


.