VBA网页提取代码更新：实现从Excel单元格动态指定数据输出工作表

我来帮你搞定这个问题！你遇到的核心问题是引用目标工作表的方式错误——你直接用Sheets("Sheet20").Range("E16").Cells(...)，但Range("E16")是单个单元格，它的Rows.Count永远是1，所以每次计算最后一行都会回到第1行，导致新数据一直覆盖第2行的内容。

修正思路 #

1. 先从Sheet20的E16单元格获取目标工作表的名称，创建对应的工作表对象，后续操作直接调用这个对象，避免重复写冗长的引用。
2. 单独计算目标工作表中对应列的最后非空行，确保每次都能找到下一个空行写入数据。
3. 把重复的配置参数（比如class名、子节点索引）提取成变量，让代码更简洁易维护，贴合你复用代码的需求。

修正后的完整代码 #

Dim targetSheetName As String
Dim targetWs As Worksheet
Dim className As String
Dim childIndex As Integer
Dim lastRow As Long
Dim HtmlText As String ' 确保变量已声明

' 从Sheet20读取配置参数
className = Sheets("Sheet20").Range("A18").Value
childIndex = Sheets("Sheet20").Range("B18").Value
targetSheetName = Sheets("Sheet20").Range("E16").Value

' 验证目标工作表是否存在（可选，提升代码健壮性）
On Error Resume Next
Set targetWs = ThisWorkbook.Sheets(targetSheetName)
On Error GoTo 0
If targetWs Is Nothing Then
    MsgBox "指定的工作表 " & targetSheetName & " 不存在，请检查Sheet20的E16单元格！"
    Exit Sub
End If

' 处理HTML元素提取与写入逻辑
If element.getElementsByClassName(className)(childIndex) Is Nothing Then
    ' 找到目标工作表A列的下一个空行
    lastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1
    targetWs.Cells(lastRow, "A").Value = "-"
Else
    ' 提取文本并写入下一行
    HtmlText = element.getElementsByClassName(className)(childIndex).innerText
    lastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1
    targetWs.Cells(lastRow, "A").Value = HtmlText
End If

关键改动说明 #

• 创建工作表对象：通过Set targetWs = ThisWorkbook.Sheets(targetSheetName)直接获取目标工作表的对象，后续所有操作都用targetWs，彻底避免了原代码中错误的单元格引用方式。
• 正确计算最后一行：lastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1 这行代码会准确找到目标工作表A列最后一个非空单元格的下一行，保证数据不会被覆盖。
• 提取配置变量：把className、childIndex、targetSheetName都提取成变量，后续修改参数时只需调整变量赋值部分，不用在代码里反复查找，完美适配你复用代码的需求。
• 增加错误处理：添加了目标工作表不存在的判断，避免因E16输入错误导致代码崩溃。

复用扩展建议 #

如果你要处理A到K列的不同class和子节点，可以把核心逻辑封装成一个通用子过程，比如：

Sub WriteToTargetSheet(classCell As Range, childCell As Range, outputCol As String)
    Dim targetSheetName As String
    Dim targetWs As Worksheet
    Dim className As String
    Dim childIndex As Integer
    Dim lastRow As Long
    Dim HtmlText As String

    ' 读取配置
    className = classCell.Value
    childIndex = childCell.Value
    targetSheetName = Sheets("Sheet20").Range("E16").Value

    ' 验证工作表
    On Error Resume Next
    Set targetWs = ThisWorkbook.Sheets(targetSheetName)
    On Error GoTo 0
    If targetWs Is Nothing Then
        MsgBox "指定的工作表不存在！"
        Exit Sub
    End If

    ' 写入逻辑
    If element.getElementsByClassName(className)(childIndex) Is Nothing Then
        lastRow = targetWs.Cells(targetWs.Rows.Count, outputCol).End(xlUp).Row + 1
        targetWs.Cells(lastRow, outputCol).Value = "-"
    Else
        HtmlText = element.getElementsByClassName(className)(childIndex).innerText
        lastRow = targetWs.Cells(targetWs.Rows.Count, outputCol).End(xlUp).Row + 1
        targetWs.Cells(lastRow, outputCol).Value = HtmlText
    End If
End Sub

调用时只需传入不同参数即可：

' 处理A列
WriteToTargetSheet Sheets("Sheet20").Range("A18"), Sheets("Sheet20").Range("B18"), "A"
' 处理B列
WriteToTargetSheet Sheets("Sheet20").Range("A19"), Sheets("Sheet20").Range("B19"), "B"
' ...以此类推处理其他列

这样就不用重复编写大量相同代码，完全实现单代码复用的目标。

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