Excel VBA突发错误91：对象变量未设置，代码未修改失效求助

我编写了一个按星期跟踪条形码的Excel VBA宏：扫码时时间会通过公式自动填入下一个单元格（此功能运行正常）；每日结束时需回扫物料，为此为每天的顶部单元格（如周一对应A1）编写了宏，当条码扫码至A1时，会在指定行（如B行）查找该条码，找到后在入库时间下方填入出库时间。此前代码运行正常，保存文件等待物料期间未对代码做任何修改，如今测试时却突然报错Object variable or With block variable not set（错误代码91），报错位置已在代码中标注。

原代码如下：

Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Call monday
        Application.EnableEvents = True
    End If
If Not Intersect(Target, Me.Range("F1")) Is Nothing Then
        Call tuesday
        Application.EnableEvents = True
    End If
If Not Intersect(Target, Me.Range("K1")) Is Nothing Then
        Call wednesday
        Application.EnableEvents = True
    End If
If Not Intersect(Target, Me.Range("P1")) Is Nothing Then
        Call thursday
        Application.EnableEvents = True
    End If
If Not Intersect(Target, Me.Range("U1")) Is Nothing Then
        Call friday
        Application.EnableEvents = True
    End If
End Sub

Sub monday()
Dim barcode As String
Dim rng As Range
Dim foundval As Range
Dim diff As Double

Dim rownumber As Long

barcode = ActiveSheet.Cells(1, 1)
If barcode <> "" Then
    Set rng = ActiveSheet.Range("b5:b500").Find(what:=barcode, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        ActivrSheet.Cells(1, 1) = "" ' 拼写错误点
    Else
        rownumber = rng.Row
        ActiveSheet.Range(Cells(rownumber, 1), Cells(rownumber, 4)).Find("").Select ' 错误触发位置
        ActiveCell.Value = Time
        ActiveCell.NumberFormat = "h:mm AM/PM"
        ActiveSheet.Cells(1, 1) = ""
    End If
End If
ActiveSheet.Cells(1, 1).Select
End Sub

Sub tuesday()
Dim barcode As String
Dim rng As Range
Dim foundval As Range
Dim diff As Double

Dim rownumber As Long

barcode = ActiveSheet.Cells(1, 6)
If barcode <> "" Then
    Set rng = ActiveSheet.Range("g:g").Find(what:=barcode, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        ActiveSheet.Cells(1, 6) = ""
    Else
        rownumber = rng.Row
        ActiveSheet.Range(Cells(rownumber, 6), Cells(rownumber, 9)).Find("").Select
        ActiveCell.Value = Time
        ActiveCell.NumberFormat = "h:mm AM/PM"
        ActiveSheet.Cells(1, 6) = ""
    End If
End If
ActiveSheet.Cells(1, 6).Select
End Sub

Sub wednesday()
Dim barcode As String
Dim rng As Range
Dim foundval As Range
Dim diff As Double

Dim rownumber As Long

barcode = ActiveSheet.Cells(1, 11)
If barcode <> "" Then
    Set rng = ActiveSheet.Range("l:l").Find(what:=barcode, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        ActiveSheet.Cells(1, 11) = ""
    Else
        rownumber = rng.Row
        ActiveSheet.Range(Cells(rownumber, 11), Cells(rownumber, 14)).Find("").Select
        ActiveCell.Value = Time
        ActiveCell.NumberFormat = "h:mm AM/PM"
        ActiveSheet.Cells(1, 11) = ""
    End If
End If
ActiveSheet.Cells(1, 11).Select
End Sub

Sub thursday()
Dim barcode As String
Dim rng As Range
Dim diff As Double

Dim rownumber As Long

barcode = ActiveSheet.Cells(1, 16)
If barcode <> "" Then
    Set rng = ActiveSheet.Range("q:q").Find(what:=barcode, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        ActiveSheet.Cells(1, 16) = ""
    Else
        rownumber = rng.Row
        ActiveSheet.Range(Cells(rownumber, 16), Cells(rownumber, 19)).Find("").Select
        ActiveCell.Value = Time
        ActiveCell.NumberFormat = "h:mm AM/PM"
        ActiveSheet.Cells(1, 16) = ""
    End If
End If
ActiveSheet.Cells(1, 16).Select
End Sub

Sub friday()
Dim barcode As String
Dim rng As Range
Dim diff As Double

Dim rownumber As Long

barcode = ActiveSheet.Cells(1, 21)
If barcode <> "" Then
    Set rng = ActiveSheet.Range("v:v").Find(what:=barcode, _
    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        ActiveSheet.Cells(1, 21) = ""
    Else
        rownumber = rng.Row
        ActiveSheet.Range(Cells(rownumber, 21), Cells(rownumber, 24)).Find("").Select
        ActiveCell.Value = Time
        ActiveCell.NumberFormat = "h:mm AM/PM"
        ActiveSheet.Cells(1, 21) = ""
    End If
End If
ActiveSheet.Cells(1, 21).Select
End Sub

错误原因分析 #

1. 拼写错误：monday子过程中ActivrSheet是拼写错误，应为ActiveSheet，会直接导致对象引用失败。
2. Find方法未处理空结果：当指定范围内没有空单元格时，Find("")返回Nothing，直接调用.Select会触发错误91。
3. 事件逻辑漏洞：Worksheet_Change中每次调用子过程后直接开启事件，但未先关闭事件，可能触发递归调用，影响代码稳定性。

修复后的完整代码 #

工作表事件代码 #

Private Sub worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False ' 先关闭事件，避免递归触发
    If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Call monday
    ElseIf Not Intersect(Target, Me.Range("F1")) Is Nothing Then
        Call tuesday
    ElseIf Not Intersect(Target, Me.Range("K1")) Is Nothing Then
        Call wednesday
    ElseIf Not Intersect(Target, Me.Range("P1")) Is Nothing Then
        Call thursday
    ElseIf Not Intersect(Target, Me.Range("U1")) Is Nothing Then
        Call friday
    End If
    Application.EnableEvents = True ' 统一恢复事件
End Sub

修复后的monday子过程（其他子过程同理修改） #

Sub monday()
    Dim barcode As String
    Dim rng As Range
    Dim emptyCell As Range
    Dim rownumber As Long

    barcode = ActiveSheet.Cells(1, 1).Value
    If barcode <> "" Then
        Set rng = ActiveSheet.Range("b5:b500").Find(what:=barcode, _
            LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If rng Is Nothing Then
            ActiveSheet.Cells(1, 1).Value = "" ' 修复拼写错误
        Else
            rownumber = rng.Row
            ' 按列顺序查找第一个空单元格，增加参数确保查找逻辑符合业务需求
            Set emptyCell = ActiveSheet.Range(Cells(rownumber, 1), Cells(rownumber, 4)).Find(what:="", _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
            
            If Not emptyCell Is Nothing Then
                emptyCell.Value = Time
                emptyCell.NumberFormat = "h:mm AM/PM"
                ActiveSheet.Cells(1, 1).Value = ""
            Else
                MsgBox "该行已无空单元格可填写出库时间！"
                ActiveSheet.Cells(1, 1).Value = ""
            End If
        End If
    End If
    ActiveSheet.Cells(1, 1).Select
End Sub

其他子过程修复要点 #

• 给Find("")增加变量接收结果，并判断是否为Nothing，避免直接调用.Select
• 确保所有ActiveSheet拼写正确
• 给Find方法补充LookIn:=xlValues和SearchOrder:=xlByColumns参数，按列顺序查找空单元格，贴合入库出库时间的填写逻辑

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