VBA+Selenium网页爬虫仅处理第一列，如何修复多列循环问题？

列循环失效的核心原因 #

你的外层列循环终止条件写法错误：

For j = 1 To Sheet1.Cells(Columns.Count, 1).End(xlUp).Column

Cells(Columns.Count, 1)指向第1列的最后一行单元格，End(xlUp)会定位到第1列最后一个非空单元格，再取.Column永远返回1，导致循环仅执行j=1就终止。

正确的写法是获取Sheet1中最后一个有数据的列号，推荐两种方式：

1. 基于第一行的非空列定位：

For j = 1 To Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column

2. 基于整个工作表的已用区域：

Dim lastCol As Integer
lastCol = Sheet1.UsedRange.Columns.Count
For j = 1 To lastCol

其他关键优化点 #

• 变量声明规范：原代码中Dim row_no, col_no As Integer仅col_no为Integer类型，row_no是Variant，需明确声明所有变量类型，避免潜在问题：

  Dim i As Integer, j As Integer
  Dim visitpage As String, attributionlink As String
  

• 错误捕获机制：爬虫过程中易出现链接失效、元素找不到的情况，添加错误处理可避免程序崩溃并记录问题：

  On Error Resume Next
  chrm.Get visitpage
  If Err.Number <> 0 Then
      Sheet3.Cells(i, j).Value = "访问失败: " & Err.Description
      Err.Clear
      GoTo NextRow
  End If
  

• 等待方式优化：固定8秒等待效率低下，改用Selenium的显式等待，直到目标元素加载完成：

  chrm.FindElementByXPath("/html/body/div/div/div/div[2]/main/figure/img", timeout:=10000).Attribute("src")
  

• 元素定位优化：绝对XPath（/html/body/...）对网页结构变动敏感，建议用相对定位，比如CSS选择器：

  chrm.FindElementByCss("main figure img")
  

• 资源释放：程序结束后需关闭浏览器并释放对象，避免内存泄漏：

  chrm.Quit
  Set chrm = Nothing
  Application.ScreenUpdating = True
  

修正后的完整代码示例 #

Sub scraping_web()
    Dim chrm As Selenium.ChromeDriver
    Dim i As Integer, j As Integer
    Dim lastRow As Integer, lastCol As Integer
    Dim visitpage As String
    Dim attributionlink As String
    Dim fullHTMLlink As String
    Dim alttag As String

    Application.ScreenUpdating = False
    Set chrm = New Selenium.ChromeDriver
    chrm.Start

    ' 获取Sheet1的最后行和最后列
    lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column

    For j = 1 To lastCol
        For i = 3 To lastRow
            visitpage = Sheet1.Cells(i, j).Value
            ' 跳过空链接
            If visitpage = "" Then
                Sheet3.Cells(i, j).Value = "空链接"
                GoTo NextRow
            End If

            On Error Resume Next
            chrm.Get visitpage
            If Err.Number <> 0 Then
                Sheet3.Cells(i, j).Value = "访问失败: " & Err.Description
                Err.Clear
                GoTo NextRow
            End If

            ' 点击按钮（显式等待10秒）
            chrm.FindElementByXPath("/html/body/div/div/div/div[2]/main/section[2]/div/div[2]/div/div[1]/button[2]", timeout:=10000).Click

            ' 获取图片属性
            attributionlink = chrm.FindElementByXPath("/html/body/div/div/div/div[2]/main/figure/img", timeout:=10000).Attribute("src")
            alttag = chrm.FindElementByXPath("/html/body/div/div/div/div[2]/main/figure/img", timeout:=10000).Attribute("alt")

            ' 拼接HTML内容
            fullHTMLlink = "<img src=""" & attributionlink & """ alt=""This is a Creative Commons image with the title " & alttag & """>"
            Sheet3.Cells(i, j).Value = fullHTMLlink & chrm.FindElementById("attribution-html", timeout:=10000).Text

NextRow:
        Next i
    Next j

    ' 释放资源
    chrm.Quit
    Set chrm = Nothing
    Application.ScreenUpdating = True
End Sub

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