WEBDEN VERİ ALMA

[EMRE YALÇIN]

Merhaba. https://finans.mynet.com/borsa/hisseler/ bu siteden borsa hisselerine ait verileri excele almak istiyorum.Teşekkürler.

 

[Erdem Akdemir]

Aş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.

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

 

[EMRE YALÇIN]

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.

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

 

[EMRE YALÇIN]

Erdem bey hata verdi. SİTE AÇIKKEN MAKROYU BUTONA ATADIM

 

[Erdem Akdemir]

Sarı ile işaretli nesneleri vba ekranında Tools>References 'tan ekleyin.

 

[EMRE YALÇIN]

TEŞEKKÜRLER

 

[Levent Menteşoğlu]

Bu işlemi alternatif olarak, Excel'in "Verileri Al" ya da "Dış Veri Al" özelliği ile makro kullanmadan da yapabilirsiniz.

 

[ibere]

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.

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 ?

 

[EMRE YALÇIN]

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

Harikasınız hepiniz teşekkürler.

 

[Erdem Akdemir]

hocam xmlhttp kodu yazabilmek adına yardımcı kaynak önerebilir misiniz ?

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.

 

[ibere]

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.

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.

Saygılarımla..

 

[Erdem Akdemir]

Xmlhttp eğitimi verecek kadar konuya hakim değilim.
Aşağıdaki videoyu fikir vermesi açısından izleyebilirsiniz.

 

[mekist]

Aş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.

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

Erdem Hocam Merhaba
Makro ile veriyi mi almak yoksa Excelin "Verileri Al" yaparak mı almak daha hızlı sonuç verir
Örneğin bu sayfadaki veriler

Temel Hisse Değerleri ve Oranları | İş Yatırım

Temel Değerler ve Oranlar. Yatırım kararı alırken araştırmalarınıza yardımcı olacak Hisse Değerleri ve Oranları İş Yatırım'da!

www.isyatirim.com.tr

 

[mekist]

Merhaba

Testi yaptım, karşılaştırılamayacak kadar bu yöntem hızlı sonuç verdi
Farklı etkileri olabilir, onları da karşılaşınca yazarım