excel - 使用查询选择器从 VBA 中抓取

Question

我已使用此网站的代码从 site 提取数据:

Option Explicit
Public Sub GetInfo()
    Dim sResponse As String, i As Long, Html As New HTMLDocument
    Dim prices As Object, info As Object
    Application.ScreenUpdating = False
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://bazashifer.ru/proflist-profnastil", False
        .send
        sResponse = .responseText
    End With
    With Html
        .body.innerHTML = sResponse
        Set info = .querySelectorAll("div.views-field.views-field-title")
        Set prices = .querySelectorAll("div.views-field.views-field-field-cena-tovara")
    End With
    With Worksheets(2)
        For i = 0 To info.Length - 1
            .Cells(i + 1, 1) = info(i).innerText
            .Cells(i + 1, 2) = prices(i).innerText
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

上面的代码按预期工作。我实现了代码来获取多个链接( link 1 、 link 2 、 link 3 ):

Option Explicit
Public Sub GetInfoAll()
Dim wsSheet As Worksheet, Rows As Long, http As New XMLHTTP60, Html As New HTMLDocument, links As Variant, link As Variant
Dim prices As Object, info As Object, i As Long, sResponse As String
Set wsSheet = Sheets(1)
Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).row
links = wsSheet.Range("A1:A" & Rows)
    With http
    For Each link In links
        .Open "GET", link, False
        .send
         sResponse = .responseText
        With Html
        .body.innerHTML = sResponse
        Set info = .querySelectorAll("div.views-field.views-field-title")
        Set prices = .querySelectorAll("div.views-field.views-field-field-cena-tovara")
    End With
    With Worksheets(2)
        For i = 0 To info.Length - 1
            .Cells(i + 1, 1) = info(i).innerText
            .Cells(i + 1, 2) = prices(i).innerText
        Next i
    End With
   Next link
 End With
End Sub

上面的代码可以工作并且应该将数据拉入列中，但是对于下一个链接，代码会重写数据。任何帮助都会很棒。谢谢

Answer 1

Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).row

在工作表 2 上的输出循环期间，您需要有类似的内容，因为您无法对结果数量进行硬编码。

编辑这里是我对输出的真正含义

Public Sub GetInfoAll()
Dim wsSheet As Worksheet, Rows As Long, http As New XMLHTTP60, Html As New HTMLDocument, links As Variant, link As Variant
Dim prices As Object, info As Object, i As Long, sResponse As String, offsetRows As Long

Dim wb As Workbook
Set wb = Application.Workbooks("Book1")
Set wsSheet = wb.Sheets(1)
Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
links = wsSheet.Range("A1:A" & Rows)
    With http
    For Each link In links
        .Open "GET", link, False
        .send
         sResponse = .responseText
        With Html
        .body.innerHTML = sResponse
        Set info = .querySelectorAll("div.views-field.views-field-title")
        Set prices = .querySelectorAll("div.views-field.views-field-field-cena-tovara")
    End With
    With wb.Worksheets(2)
        For i = 0 To info.Length - 1
            offsetRows = 0
            offsetRows = wb.Worksheets(2).Cells(wb.Worksheets(2).Rows.Count, "A").End(xlUp).Row + 1
            .Cells(offsetRows, 1) = info(i).innerText
            .Cells(offsetRows, 2) = prices(i).innerText
        Next i
    End With
   Next link
 End With
End Sub