使用VBA进行Web Scraping时如何拆分无标识的strong标签价格数据

你可以通过匹配historyPrice下子div内的span文本标识来对应提取不同类型的价格，自动兼容购买价缺失的场景，原有代码的URL导航逻辑位置错误问题也同步修正：

实现逻辑 #

• 初始化购买价为默认占位符not found，无需额外判断购买价对应的div是否存在
• 遍历historyPrice下的所有子div，读取span标签的文本判断价格类型
• 提取同div下strong标签内的价格数值，赋值给对应变量即可

修正后完整代码 #

Sub PlayerValues()
    Dim ie As New SHDocVw.InternetExplorer
    Dim HTMLdoc As MSHTML.HTMLDocument
    Dim historyPriceDiv As MSHTML.IHTMLElement
    Dim subDiv As MSHTML.IHTMLElement
    Dim ws As Worksheet
    Dim lastRow As Long, currentRow As Long
    ' 替换为你实际使用的工作表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ie.Visible = False
    lastRow = ws.Cells(Rows.Count, 10).End(xlUp).Row
    
    For currentRow = 7 To lastRow
        ' 每个行对应不同的URL，导航逻辑放到循环内
        ie.Navigate ws.Cells(currentRow, 11).Value
        ' 等待页面加载完成
        Do While ie.ReadyState <> READYSTATE_COMPLETE Or ie.Busy
            DoEvents
        Loop
        Application.Wait (Now + TimeValue("0:00:3"))
        Set HTMLdoc = ie.Document
        
        ' 初始化三个价格变量，购买价默认设为not found
        Dim buyPrice As String, minPrice As String, maxPrice As String
        buyPrice = "not found"
        
        ' 获取historyPrice节点
        Set historyPriceDiv = HTMLdoc.getElementsByClassName("historyPrice")(0)
        If Not historyPriceDiv Is Nothing Then
            ' 遍历所有子div
            For Each subDiv In historyPriceDiv.getElementsByTagName("div")
                Dim priceType As String, priceVal As String
                priceType = subDiv.getElementsByTagName("span")(0).innerText
                priceVal = subDiv.getElementsByTagName("strong")(0).innerText
                
                ' 根据标识匹配价格类型
                Select Case priceType
                    Case "Gekauft": buyPrice = priceVal
                    Case "Tiefstwert": minPrice = priceVal
                    Case "Höchstwert": maxPrice = priceVal
                End Select
            Next subDiv
        End If
        
        ' 输出结果，可根据需要修改为写入单元格逻辑
        Debug.Print "购买价：" & buyPrice
        Debug.Print "最低价：" & minPrice
        Debug.Print "最高价：" & maxPrice
        Debug.Print "----------"
    Next currentRow
    
    ie.Quit
    Set ie = Nothing
End Sub

如果需要将结果写入工作表，直接把Debug.Print部分替换为单元格赋值逻辑即可，比如ws.Cells(currentRow, 12) = buyPrice这类写法。

内容的提问来源于stack exchange，提问作者Poseidon