web' den veri çekme kod kısaltma hk.

[pNouma]

Merhabalar,

Aşağıdaki kodda;

For Each htmlTablo In htmlTablolar
.....................
Next htmlTablo

yerine Tablonun id' si (cr1) veya class name ("genTbl closedTbl crossRatesTbl elpTbl elp25") belirtirek kodu nasıl düzenleyebiliriz?

yardımlarınız için şimdiden teşekkürler

iyi akşamlar.

Sub SP_US_500()
On Error Resume Next
Dim SH As Worksheet
Dim zaman As Double
Dim r As Long
Dim c As Integer

Dim IE As New InternetExplorer
Dim doc As HTMLDocument
Dim htmlDOC As MSHTML.HTMLDocument
Dim htmlTablo As MSHTML.IHTMLElement
Dim htmlTablolar As MSHTML.IHTMLElementCollection
Dim htmlSatir As MSHTML.IHTMLElement
Dim htmlElaman As MSHTML.IHTMLElement

Application.DisplayAlerts = False

zaman = Timer

Set SH = Sheets("sp500")

SH.Cells.ClearContents
SH.Activate
 
With IE
    .navigate "https://tr.investing.com/indices/investing.com-us-500-components"
End With

Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE

  Set htmlDOC = IE.document
      
 Application.Wait (Now + TimeValue("00:00:01"))

r = 1: c = 1

Set htmlTablolar = htmlDOC.getElementsByTagName("table")

For Each htmlTablo In htmlTablolar

    For Each htmlSatir In htmlTablo.getElementsByTagName("tr")
        c = 1
        
            For Each htmlElaman In htmlSatir.Children

                   SH.Cells(r, c) = htmlElaman.innerText

                    c = c + 1

            Next htmlElaman


        r = r + 1
    Next htmlSatir

Next htmlTablo

SH.Range("A:Z").EntireColumn.AutoFit

40:

Application.DisplayAlerts = True

IE.Quit

Set SH = Nothing

 Set htmlDOC = Nothing
 
 ThisWorkbook.Save

 MsgBox "işlem tamam.." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - zaman, "0.00") & " Saniye", vbInformation

End Sub

 

[Haluk]

Sub Test()
    Dim IE As Object, URL As String, myTable As Object, i As Long, j As Long
    
    URL = "https://tr.investing.com/indices/investing.com-us-500-components"
    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
    
    Do Until IE.ReadyState = 4
    Loop
    
    Set myTable = IE.Document.getElementById("cr1")
    
    For i = 0 To myTable.Rows.Length - 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            Cells(i + 1, j + 1) = myTable.Rows(i).Cells(j).innerText
        Next
    Next
    
    IE.Quit
    Set myTable = Nothing
    Set IE = Nothing
End Sub

.

 

[pNouma]

Sub Test()
    Dim IE As Object, URL As String, myCheck As String
   
    URL = "https://tr.investing.com/indices/investing.com-us-500-components"
   
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
   
    Do Until IE.ReadyState = 4
    Loop
   
    Set myTable = IE.Document.getElementById("cr1")
   
    For i = 0 To myTable.Rows.Length - 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            Cells(i + 1, j + 1) = myTable.Rows(i).Cells(j).innerText
        Next
    Next
   
    IE.Quit
    Set myTable = Nothing
    Set IE = Nothing
End Sub

.

Haluk Hocam çok teşekkürler, emeğinize sağlık

 

[pNouma]

Haluk Hocam tekrar merhaba,
emin olmak için sormak istiyorum,
kodun başına aşağıdaki satırları ekleyince kodlar çok hızlı çalışıyor,
bunun bir sıkıntısı olabilir mi?
tekrar teşekkürler,
iyi akşamlar.

Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
..............................
..............................................
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

 

[Haluk]

Her turlu kodda kullanilmaz, kodun isleyisine engel olmayan yerlerde kullanabilirsiniz.

.

 

[pNouma]

Her turlu kodda kullanilmaz, kodun isleyisine engel olmayan yerlerde kullanabilirsiniz.

.

Haluk Hocam ben bu kod özelinde sormuştum,
Application.Calculation = xlCalculationManual
ekleyince hızda çok fazla fark etti de o nedenle sormuştum
tekrar teşekkürler,
iyi pazarlar.