VBA HTML网页拉不匹配

Question

i获得了一个代码块，该代码本应吸引项目列表＆amp;eBay上物品的定价。它似乎在大多数情况下工作，只是价格上有一些不匹配（价格比清单还多。）。关于为什么会发生的任何想法？

Public IE As New SHDocVw.InternetExplorer
Sub GetData()
Dim HTMLdoc As MSHTml.HTMLDocument
Dim othwb As Variant
Dim objShellWindows As New SHDocVw.ShellWindows
Set IE = CreateObject("internetexplorer.application")
    With IE
        .Visible = False
        .Navigate "https://www.ebay.com/sch/i.html?_from=R40&_trksid=m570.l1313&_nkw=brooks+brothers&_sacat=1059&LH_TitleDesc=0&_osacat=1059&_odkw=brooks+brothers&LH_TitleDesc=0"
        While .Busy Or .ReadyState <> 4: DoEvents: Wend

            Set HTMLdoc = IE.Document
            ProcessHTMLPage HTMLdoc
        .Quit
    End With

End Sub
Sub ProcessHTMLPage(HTMLPage As MSHTml.HTMLDocument)
Dim HTMLItem As MSHTml.IHTMLElement
Dim HTMLItems As MSHTml.IHTMLElementCollection
Dim HTMLInput As MSHTml.IHTMLElement
Dim rownum As Long
rownum = 1
Set HTMLItems = HTMLPage.getElementsByClassName("s-item__title")
For Each HTMLItem In HTMLItems
        Cells(rownum, 1).Value = HTMLItem.innerText
        rownum = rownum + 1
Next HTMLItem
rownum = 1
Set HTMLItems = HTMLPage.getElementsByClassName("s-item__price")
For Each HTMLItem In HTMLItems
        Cells(rownum, 2).Value = HTMLItem.innerText
        rownum = rownum + 1
Next HTMLItem

End Sub

Answer 1

首先，将选择器更改为限制到列表主部分，以避免最近查看的项目。然后，您可以一一处理列表。在下面的示例中，我将所有列出的价格（不包括StrikeThrough）拿到一个包含相关标题的阵列中。您可以redim preserve数组尺寸或简单地提取LBOUND项目以获取第一个价格。价格

Option Explicit    
Public Sub GetInfo()
    Dim ie As InternetExplorer, arr(), col
    Set ie = New InternetExplorer
    Set col = New Collection
    With ie
        .Visible = True
        .navigate "https://www.ebay.com/sch/i.html?_from=R40&_nkw=brooks+brothers&_sacat=1059&LH_TitleDesc=0&LH_TitleDesc=0&rt=nc&_ipg=48&_pgn=1"
        While .Busy Or .readyState < 4: DoEvents: Wend
        Dim listedItems As Object, item As Object, prices As Object, price As Object, j As Long
        Set listedItems = .document.getElementById("mainContent").getElementsByClassName("s-item")
        For Each item In listedItems
            Set prices = item.getElementsByClassName("s-item__price")
            ReDim arr(0 To prices.Length - 1)    'you could limit this after by redim to 0 to 0
            j = 0
            For Each price In prices
                arr(j) = price.innerText
                j = j + 1
            Next
            col.Add Array(item.getElementsByClassName("s-item__title")(0).innerText, arr)
        Next
        .Quit
        Dim item2 As Variant, rowNum As Long
        For Each item2 In col
            rowNum = rowNum + 1
            With ThisWorkbook.Worksheets("Sheet1")
                .Cells(rowNum, 1) = Replace$(Trim$(item2(0)), Chr$(10), Chr$(32))
                .Cells(rowNum, 2).Resize(1, UBound(item2(1)) + 1) = item2(1)
            End With
        Next
    End With
End Sub