• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

WEBDEN VERİ ALMA

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.

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
 
Son düzenleme:
Erdem Akdemir' Alıntı:
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
Genişletmek için tıkla ...
 

Ekli dosyalar

  • hata x.png
    hata x.png
    134.1 KB · Görüntüleme: 26
Sarı ile işaretli nesneleri vba ekranında Tools>References 'tan ekleyin.

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

240566

240567
 
Son düzenleme:
Erdem Akdemir' Alıntı:
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
Genişletmek için tıkla ...

hocam xmlhttp kodu yazabilmek adına yardımcı kaynak önerebilir misiniz ?
 
ibere' Alıntı:
hocam xmlhttp kodu yazabilmek adına yardımcı kaynak önerebilir misiniz ?
Genişletmek için tıkla ...

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 Akdemir' Alıntı:
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.
Genişletmek için tıkla ...

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..
 
Xmlhttp eğitimi verecek kadar konuya hakim değilim.
Aşağıdaki videoyu fikir vermesi açısından izleyebilirsiniz.

 
Erdem Akdemir' Alıntı:
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.

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
Genişletmek için tıkla ...

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 www.isyatirim.com.tr
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst