解决VBA运行时错误'424'：For Each Cell In rg行提示需要对象

错误触发原因 #

运行时错误'424'（需要对象）是因为rg变量未被正确赋值为有效的Range对象，具体错误点如下：

• 变量声明不规范：Dim rg, Cell As Range 按照VBA语法规则，只有末尾的Cell被显式声明为Range类型，前面的rg会被默认定义为Variant类型，无法稳定存储Range对象。
• rg赋值语句语法错误：Set rg行末尾多余了.Cell属性，Range对象无该顶层属性，直接导致对象赋值失败；同时语句中第二个Sheet2.Range("B1")未指定所属工作簿，会默认指向运行代码的当前工作簿，而非你打开的OpenBook，如果当前工作簿不存在Sheet2也会引发对象缺失错误。
• 后续代码中的Sheet1、Sheet2未明确指定所属工作簿，存在上下文匹配错误的隐患。

修正后的代码 #

Sub extract()
    Dim i As Integer
    Dim OpenBook As Workbook
    Dim FileLocation As String
    ' 修正变量声明，两个变量都明确为Range类型
    Dim rg As Range, Cell As Range
    
    FileLocation = "C:\xxxxx" ' VBA路径中单反斜杠即可正常识别
    
    Set OpenBook = Application.Workbooks.Open(FileLocation)
    ' 修正rg赋值：去掉冗余的.Cell，所有Sheet2明确归属OpenBook
    With OpenBook.Sheet2
        Set rg = .Range("B1", .Range("B1").End(xlDown))
    End With
    i = 0
    
    For Each Cell In rg
        ' 明确Sheet1归属当前运行代码的工作簿，避免上下文混乱
        If ThisWorkbook.Sheet1.Range("G2").Value = Cell.Value Then
            i = i + 1
            ThisWorkbook.Sheet1.Range("G7").Offset(i, 0).Value = Cell.Offset(0, 1).Value
        End If
    Next Cell
    
    ' 按需补充关闭OpenBook的逻辑，避免后台残留Excel进程
    ' OpenBook.Close SaveChanges:=False
End Sub

额外注意事项 #

• 如果代码中Sheet1是属于你打开的OpenBook而非当前工作簿，将代码里的ThisWorkbook.Sheet1替换为OpenBook.Sheet1即可。
• 建议补充打开工作簿后的异常捕获逻辑，以及任务完成后关闭已打开工作簿的逻辑，避免后台残留多余Excel进程。

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