Question

我编写了以下代码，该代码基于URL（在单元格B2中）擦除网页，然后输出从C2中的页面中删除的数字。

Sub Scrape()
    Dim ObjIE As Object
    Set ObjIE = CreateObject("InternetExplorer.Application")
    ObjIE.Navigate Sheets("facebook").Range("B2").Value

    Application.StatusBar = "Loading, Please wait..."

    Do While ObjIE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Application.StatusBar = "Searching for value. Please wait..."

    Dim dd As String
    dd = ObjIE.Document.getElementsByClassName("_3xom")(0).innerText

    Sheets("Facebook").Range("C2") = dd

    Dim cell As Range
End Sub

我在列B中有更多的URL。我需要找到一些代码，这些代码将重复宏，但分别将两个单元格引用更改为“B3”和“C3”，然后是4,5,6等等。我已经尝试过所有类型的循环但是无法解决可能会使这项工作的问题！

任何帮助都会受到超级赞赏。

Answer 1

试试这个：

Sub Scrape()
    Dim ObjIE As Object
    Dim record As Range
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("facebook")
    For Each record In Range(ws.Cells(2, 2), ws.Cells(ws.Cells.SpecialCells(xlCellTypeLastCell).Row, 2))

        Set ObjIE = CreateObject("InternetExplorer.Application")

        ObjIE.Navigate record.Value

        Application.StatusBar = "Loading, Please wait..."

        Do While ObjIE.Busy
            Application.Wait DateAdd("s", 1, Now)
        Loop


        Application.StatusBar = "Searching for value. Please wait..."

        Dim dd As String
        dd = ObjIE.Document.getElementsByClassName("_3xom")(0).innerText
        record.Offset(0, 1).Value = dd
    Next record
End Sub

我们在第2列（“B”）中遍历所有单元格，然后我们进行“刮擦”并将值放在下一列中，即3（“C”）。

Answer 2

以下内容如何：

Sub Scrape()
Dim cell As Range
Dim dd As String
Dim ObjIE As Object
Dim i As Long, LastRow As Long
Dim ws As Worksheet: Set ws = Sheets("Facebook")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

For i = 2 To LastRow

    Set ObjIE = CreateObject("InternetExplorer.Application")

    ObjIE.Navigate ws.Cells(i, 2).Value 'this refers to row i in column 2 (ie. B)

    Application.StatusBar = "Loading, Please wait..."

    Do While ObjIE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Application.StatusBar = "Searching for value. Please wait..."

    dd = ObjIE.Document.getElementsByClassName("_3xom")(0).innerText

    ws.Cells(i, 3).Value = dd 'this refers to row i in column 3 (ie. C)
Next i
End Sub

如何重复更改

2 个答案: