Блог

Я смог создать макрос, в котором он будет просматривать весь список веб-сайтов в столбце J, начиная со строки 2 (заголовок в строке 1). Получите нужную мне информацию с каждого веб-сайта, затем отобразите их в столбце K, который находится рядом с веб-сайтами, с которых была взята информация. Единственная проблема в том, что я не могу заставить макрос перейти на каждый из веб-сайтов. Я не знаю, что не так с кодом.

 Sub CommandButton1_Click()
    Dim ie As Object
    Dim lastrow As Integer
    Dim i As Integer
    Dim myURL As String
    Dim sdd As String
    Dim add As Variant
    Dim html As Object
    Dim mylinks As Object
    Dim mylink As Object
    Dim result As String

    ' Create InternetExplorer Object
    Set ie = CreateObject("InternetExplorer.Application")

    lastrow = Sheet1.Cells(Rows.Count, "J").End(xlUp).Row
    For i = 2 To lastrow
    myURL = Sheet1.Cells(i, "J").Value

    ' Hide InternetExplorer
    ie.Visible = False

    ' URL to get data from
    ie.navigate myURL

    ' Loop until page fully loads
    Do While ie.readystate <> READYSTATE_COMPLETE
    Loop

    ' Information i want to get from the URLs
    sdd = ie.document.getelementsbyclassname("timeline-text")(0).innerText

    ' Format the result
    add = Split(sdd, "$")
    Range("K3") = add(1)

    ' Close InternetExplorer
    ie.Quit

    'Return to Normal?
    ie.Visible = True
    End
    Next
    ' Clean up
    Set ie = Nothing

    Application.StatusBar = ""

End Sub
  

85 100 долларов — это информация, которую я хочу получить с одного из URL-адресов.

 <span class="font-size-base font-normal">Est.</span>
<span itemprop="price" content="85100">$85,100</span>
  

Не выходите из IE, пока не завершите цикл. Просто перейдите к следующему URL-адресу и запишите информацию о новой странице в той же строке, из которой был получен URL.

 Sub CommandButton1_Click()

    Dim lastrow As Long, i As Long
    Dim sdd As String, myURL As String, result As String
    Dim add As Variant
    Dim ie As Object, html As Object, mylinks As Object, mylink As Object

    ' Create InternetExplorer Object
    Set ie = CreateObject("InternetExplorer.Application")
    ' Hide InternetExplorer
    ie.Visible = False

    lastrow = Sheet1.Cells(Rows.Count, "J").End(xlUp).Row
    For i = 2 To lastrow

        'collect next web page url
        myURL = Sheet1.Cells(i, "J").Value

        ' URL to get data from
        ie.navigate myURL

        ' Loop until page fully loads
        Do While ie.readystate <> READYSTATE_COMPLETE
            'allow other process through the message queue
            DoEvents
        Loop

        ' Information i want to get from the URLs
        sdd = ie.document.getelementsbyclassname("timeline-text")(0).innerText

        ' Format the result
        add = Split(sdd, "$")
        Sheet1.Cells(i, "K") = add(1)

    Next i

    'Return to Normal?
    ie.Visible = True
    ' Close InternetExplorer
    ie.Quit
    ' Clean up
    Set ie = Nothing

    Application.StatusBar = ""

End Sub
  

Я также добавил DoEvents в цикл ожидания загрузки страницы. Это позволяет выполнять другие процессы вместо привязки ресурсов в однопоточном процессе VBA.

есть кое-что, на что вы должны обратить внимание при программировании. Всегда старайтесь отображать видимый результат.

Сделайте это перед циклом после lastrow msgbox lastrow Например, между циклом for, сделайте что-то вроде msgbox sdd Вы должны быть в состоянии определить, где лежат ошибки.

Я надеюсь, что это поможет.