excel - 遍历一个列表，然后将结果粘贴到其下一个单元格

Question

我能够创建一个宏，其中它将遍历 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>

Answer 1

在完成循环之前不要退出 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 进程中占用资源。