- Katılım
- 21 Haziran 2021
- Mesajlar
- 64
- Excel Vers. ve Dili
- türkçe
- Altın Üyelik Bitiş Tarihi
- 20-07-2023
Merhaba. https://finans.mynet.com/borsa/hisseler/ bu siteden borsa hisselerine ait verileri excele almak istiyorum.Teşekkürler.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub mynett()
Dim xmlsayfa As MSXML2.XMLHTTP60
Dim htmldoc As MSHTML.HTMLDocument
Dim table As IHTMLElementCollection
Dim satir As IHTMLElement
Dim hucre As IHTMLElement
Range("A2:F" & Rows.Count).ClearContents
Set xmlsayfa = New MSXML2.XMLHTTP60
Set htmldoc = New MSHTML.HTMLDocument
xmlsayfa.Open "GET", "https://finans.mynet.com/borsa/hisseler/", False
xmlsayfa.send
If xmlsayfa.Status <> 200 Then Exit Sub
htmldoc.body.innerHTML = xmlsayfa.responseText
Set table = htmldoc.getElementsByTagName("tbody")
x = 2
For Each satir In table.Item(0).Children
s = 1
For Each hucre In satir.Children
If IsNumeric(hucre.innerText) Then
Cells(x, s) = ("'" & hucre.innerText)
Cells(x, s) = Cells(x, s) * 1
Else
Cells(x, s) = hucre.innerText
End If
s = s + 1
Next hucre
x = x + 1
Next satir
Set xmlsayfa = Nothing
Set htmldoc = Nothing
Set table = Nothing
Set satir = Nothing
Set hucre = Nothing
End Sub
Aşağıdaki kodu kullanabilirsiniz.
Kod uzamasın diye başlıkları aldım onları siz ekleyin.
Veriler ikinci satırdan itibaren gelecektir. Sütunları bir defaya mahsus biçimlendirmek gerekir.
Değişim okları gelmediği için arada bir sütun boş görünecek. İlerde resimlerde getirilebilir.
Kod:Sub mynett() Dim xmlsayfa As MSXML2.XMLHTTP60 Dim htmldoc As MSHTML.HTMLDocument Dim table As IHTMLElementCollection Dim satir As IHTMLElement Dim hucre As IHTMLElement Range("A2:F" & Rows.Count).ClearContents Set xmlsayfa = New MSXML2.XMLHTTP60 Set htmldoc = New MSHTML.HTMLDocument xmlsayfa.Open "GET", "https://finans.mynet.com/borsa/hisseler/", False xmlsayfa.send If xmlsayfa.Status <> 200 Then Exit Sub htmldoc.body.innerHTML = xmlsayfa.responseText Set table = htmldoc.getElementsByTagName("tbody") x = 2 For Each satir In table.Item(0).Children s = 1 For Each hucre In satir.Children If IsNumeric(hucre.innerText) Then Cells(x, s) = ("'" & hucre.innerText) Cells(x, s) = Cells(x, s) * 1 Else Cells(x, s) = hucre.innerText End If s = s + 1 Next hucre x = x + 1 Next satir Set xmlsayfa = Nothing Set htmldoc = Nothing Set table = Nothing Set satir = Nothing Set hucre = Nothing End Sub
hocam xmlhttp kodu yazabilmek adına yardımcı kaynak önerebilir misiniz ?Aşağıdaki kodu kullanabilirsiniz.
Kod uzamasın diye başlıkları aldım onları siz ekleyin.
Veriler ikinci satırdan itibaren gelecektir. Sütunları bir defaya mahsus biçimlendirmek gerekir.
Değişim okları gelmediği için arada bir sütun boş görünecek. İlerde resimlerde getirilebilir.
Kod:Sub mynett() Dim xmlsayfa As MSXML2.XMLHTTP60 Dim htmldoc As MSHTML.HTMLDocument Dim table As IHTMLElementCollection Dim satir As IHTMLElement Dim hucre As IHTMLElement Range("A2:F" & Rows.Count).ClearContents Set xmlsayfa = New MSXML2.XMLHTTP60 Set htmldoc = New MSHTML.HTMLDocument xmlsayfa.Open "GET", "https://finans.mynet.com/borsa/hisseler/", False xmlsayfa.send If xmlsayfa.Status <> 200 Then Exit Sub htmldoc.body.innerHTML = xmlsayfa.responseText Set table = htmldoc.getElementsByTagName("tbody") x = 2 For Each satir In table.Item(0).Children s = 1 For Each hucre In satir.Children If IsNumeric(hucre.innerText) Then Cells(x, s) = ("'" & hucre.innerText) Cells(x, s) = Cells(x, s) * 1 Else Cells(x, s) = hucre.innerText End If s = s + 1 Next hucre x = x + 1 Next satir Set xmlsayfa = Nothing Set htmldoc = Nothing Set table = Nothing Set satir = Nothing Set hucre = Nothing End Sub
Harikasınız hepiniz teşekkürler.Bu işlemi alternatif olarak, Excel'in "Verileri Al" ya da "Dış Veri Al" özelliği ile de makro kullanmadan da yapabilirsiniz.
Ekli dosyayı görüntüle 240566
Ekli dosyayı görüntüle 240567
Yardımcı kaynak excel.web.tr diyebilirim. Sitedeki örnekleri inceleyin.hocam xmlhttp kodu yazabilmek adına yardımcı kaynak önerebilir misiniz ?
Boş vaktiniz olurda ado eğitimi gibi xmlhttp eğitim videoları çekerseniz birçok insana fayda sağlayacağını düşünüyorum. Ayrıca ado eğitiminiz için teşekkür ederim, ilgili eğitiminizden çok şey öğrendim.Yardımcı kaynak excel.web.tr diyebilirim. Sitedeki örnekleri inceleyin.
Xmlhttp nesnesi ile çalışırken sunucudan GET yöntemi ile bilgi istemek çok zor değil.
Önemli olan html yapısını anlamak, sunucudan özelleştirilmiş bilgi istenmediği sürece rahatlıkla yapılabiliyor.
İleri seviyede uzmanlaşmak isterseniz özel ders almanızı öneririm.
Erdem Hocam MerhabaAşağıdaki kodu kullanabilirsiniz.
Kod uzamasın diye başlıkları almadım, onları siz ekleyin.
Veriler ikinci satırdan itibaren gelecektir. Sütunları bir defaya mahsus biçimlendirmek gerekir.
Değişim okları gelmediği için arada bir sütun boş görünecek. İlerde resimlerde getirilebilir.
Kod:Sub mynett() Dim xmlsayfa As MSXML2.XMLHTTP60 Dim htmldoc As MSHTML.HTMLDocument Dim table As IHTMLElementCollection Dim satir As IHTMLElement Dim hucre As IHTMLElement Range("A2:F" & Rows.Count).ClearContents Set xmlsayfa = New MSXML2.XMLHTTP60 Set htmldoc = New MSHTML.HTMLDocument xmlsayfa.Open "GET", "https://finans.mynet.com/borsa/hisseler/", False xmlsayfa.send If xmlsayfa.Status <> 200 Then Exit Sub htmldoc.body.innerHTML = xmlsayfa.responseText Set table = htmldoc.getElementsByTagName("tbody") x = 2 For Each satir In table.Item(0).Children s = 1 For Each hucre In satir.Children If IsNumeric(hucre.innerText) Then Cells(x, s) = ("'" & hucre.innerText) Cells(x, s) = Cells(x, s) * 1 Else Cells(x, s) = hucre.innerText End If s = s + 1 Next hucre x = x + 1 Next satir Set xmlsayfa = Nothing Set htmldoc = Nothing Set table = Nothing Set satir = Nothing Set hucre = Nothing End Sub