如何修改VBA爬虫代码以提取网页全部产品规格项

原代码固定针对10组规格写了10个独立循环，只能提取前10组数据，遇到规格数量超过10的产品就会遗漏。之前改成For j = 1 To specs.Count却只提取最后一组，是因为每次循环都往同一个列写数据，后面的内容覆盖了前面的。

以下是修改后的完整代码：

Option Explicit
Private MB As Selenium.ChromeDriver

Sub ExtractGraingerSpecs()
    Dim i As Long, lastrow As Long
    Dim MyURL As String
    Dim specs As Selenium.WebElements, values As Selenium.WebElements
    Dim j As Long, targetCol As Long
    
    ' 初始化浏览器，避免每次循环重启
    Set MB = New Selenium.ChromeDriver
    MB.Start
    
    lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastrow
        MyURL = Sheet1.Cells(i, 1).Value
        MB.Get MyURL
        
        ' 等待规格区域加载完成，比固定等待更可靠
        MB.Wait 2000
        MB.WaitForElementPresent "[data-testid='product-techs']", 10000
        
        Set specs = MB.FindElementsByCss("[data-testid='product-techs'] dt")
        Set values = MB.FindElementsByCss("[data-testid='product-techs'] dd")
        
        ' 从B列开始，逐列写入每组规格
        targetCol = 2 ' B列对应数字2
        For j = 1 To specs.Count
            On Error Resume Next ' 跳过单个规格提取错误，继续处理下一个
            Sheet1.Cells(i, targetCol).Value = Join$(Array(specs.Item(j).Text, values.Item(j).Text), ":")
            On Error GoTo 0
            targetCol = targetCol + 1 ' 列号递增
        Next j
        
        ' 清空当前行多余的旧数据（如果之前提取过更少的规格）
        If targetCol <= 11 Then ' 如果规格少于10组，清空后面的列
            Sheet1.Range(Sheet1.Cells(i, targetCol), Sheet1.Cells(i, 11)).ClearContents
        End If
    Next i
    
    ' 所有链接处理完后关闭浏览器
    MB.Quit
    Set MB = Nothing
End Sub

关键修改说明： #

• 动态列分配：用targetCol变量从B列（数字2）开始，每处理一组规格就自动切换到下一列，不管规格数量多少都能依次写入
• 错误处理优化：用On Error Resume Next跳过单个规格的提取错误，不会因为一组规格提取失败就终止整个程序
• 浏览器复用：把ChromeDriver的初始化移到循环外，避免每次处理链接都重启浏览器，大幅提升运行效率
• 更可靠的等待：使用WaitForElementPresent等待规格区域加载完成，比固定10秒等待更灵活，也能避免页面加载慢导致的提取失败
• 清理旧数据：处理完当前产品后，清空该行多余的旧数据，避免之前的残留内容干扰

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