VBA自动筛选行报错：Run-time error '91' 对象变量未设置

我尝试给多个用户发送包含多行数据的邮件，用AutoFilter筛选对应行，但有时会触发错误：

Run-time error '91': Object variable or With block variable not set

报错代码行：

Set rng = Sheet20.AutoFilter.Range.Resize(Sheet20.AutoFilter.Range.Rows.Count - 1).Columns("$M:$U")

完整代码如下：

Sub CashEmail()
Application.ScreenUpdating = False
Sheet20.AutoFilterMode = False
Dim OutApp As Object, OutMail As Object
Dim rng As Range, i As Long, v As Variant
v = Sheet20.Range("$M$20:$V" & Sheet20.Cells(Sheet20.Rows.Count, "$M").End(xlUp).Row).Value ' Modify the range to include columns A to L and V to W
Set OutApp = CreateObject("Outlook.Application")
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(v, 1)
        If Not .Exists(v(i, 10)) And v(i, 10) <> "" Then
            .Add v(i, 10), Nothing
            With Sheet20.Range("$M21:V$21") ' Modify the range to include columns A to B and E to F
                .CurrentRegion.AutoFilter Field:=10, Criteria1:=v(i, 10)
                Set rng = Sheet20.AutoFilter.Range.Resize(Sheet20.AutoFilter.Range.Rows.Count - 1).Columns("$M:$U")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = v(i, 10)
                    .Subject = "xxxx"
                    .HTMLBody = RangetoHTML(rng)
                    .Display
                End With
            End With
        End If
    Next i
End With
Sheet20.AutoFilterMode = False
Sheet20.ShowAllData
Application.ScreenUpdating = True
End Sub

我已经在代码开头设置Sheet20.AutoFilterMode = False，但问题依然存在。

问题原因 #

报错核心是：执行AutoFilter后没有匹配到任何数据，导致Sheet20.AutoFilter对象为Nothing，此时访问Sheet20.AutoFilter.Range就会触发91错误。

修复方案 #

1. 关键修改点 #

• 添加筛选结果检查，避免空结果时访问无效对象
• 替换AutoFilter.Range的依赖，改用SpecialCells(xlCellTypeVisible)获取可见行
• 每次循环后强制清除筛选，避免状态残留

2. 修改后的完整代码 #

Sub CashEmail()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object
    Dim rng As Range, i As Long, v As Variant
    Dim dataRange As Range, filterRange As Range
    
    ' 初始化工作表，清除现有筛选
    With Sheet20
        .AutoFilterMode = False
        ' 定义明确的数据范围（包含表头）
        Set dataRange = .Range("$M20:$V" & .Cells(.Rows.Count, "$M").End(xlUp).Row)
    End With
    
    v = dataRange.Value
    Set OutApp = CreateObject("Outlook.Application")
    
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(v, 1)
            ' 跳过空邮箱
            If v(i, 10) <> "" And Not .Exists(v(i, 10)) Then
                .Add v(i, 10), Nothing
                
                ' 应用筛选
                dataRange.AutoFilter Field:=10, Criteria1:=v(i, 10)
                
                ' 检查是否有筛选结果
                On Error Resume Next
                ' 获取除表头外的可见行范围
                Set filterRange = dataRange.Offset(1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                
                If Not filterRange Is Nothing Then
                    ' 仅取M到U列的筛选结果
                    Set rng = filterRange.Columns("$M:$U")
                    
                    ' 创建并发送邮件
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = v(i, 10)
                        .Subject = "xxxx"
                        .HTMLBody = RangetoHTML(rng)
                        .Display ' 如需直接发送改为.Send
                    End With
                    
                    Set filterRange = Nothing
                End If
                
                ' 清除当前筛选
                Sheet20.AutoFilterMode = False
            End If
        Next i
    End With
    
    ' 最终清理
    Sheet20.ShowAllData
    Application.ScreenUpdating = True
End Sub

3. 额外说明 #

• 使用SpecialCells(xlCellTypeVisible)直接定位可见行，避免依赖AutoFilter对象的潜在风险
• On Error Resume Next用于处理无匹配结果的场景，确保代码不会中断
• 循环内强制清除筛选，避免后续循环受到之前筛选状态的影响

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