将项目添加到 With...End With 时出现 excel 错误 91

Question

当我在 Do/With 函数下添加项目时，我有一段代码会引发错误 91。 （感谢 chris neilsen 提供代码）

Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)

Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
            End With
            Set cl = SrchRng.FindNext(cl)
        Loop While cl.Address <> addr
    End If
Next

当它变为：时抛出错误：

Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)


Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .ClearContents
            End With
            Set cl = SrchRng.FindNext(cl)
        Loop While cl.Address <> addr
    End If
Next

唯一的添加是 Do/With 语句下的 .ClearContents，除非我遗漏了什么，否则它似乎没有添加我所知道的变量。有人有什么想法吗？

**注意：它做了它应该做的，它只是抛出一个错误。

Answer 1

当您正在清除单元格时，cl 可能是 Nothing，因此您需要删除循环外的范围，或者为 Nothing 添加测试

方法一会更快

方法一——单发删除范围

Sub A()
Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long
Dim rng2 As Range    

SearchValues = Array(217, 317, 298)

Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With    

For i = LBound(SearchValues) To UBound(SearchValues)
Set rng2 = Nothing
    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
        If Not rng2 Is Nothing Then
            Set rng2 = cl.EntireRow
        Else
            Set rng2 = Union(rng2, cl.EntireRow)
        End If
        Set cl = SrchRng.FindNext(cl)
        Loop While Not cl Is Nothing
    End If
    If Not rng2 Is Nothing Then
        With rng2
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
            .ClearContents
        End With
    End If
Next

End Sub

方法二

With cl.EntireRow
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
            .ClearContents
End With
    Set cl = SrchRng.FindNext(cl)
Loop While Not cl is Nothing  

Answer 2

试试这个代码。我已将 "Loop While cl.Address addr" 更改为 "Loop until cl Is Nothing"

Sub main()
Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)


Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .ClearContents

            End With
            Set cl = SrchRng.FindNext(cl)
            Loop Until cl Is Nothing
             'Loop While cl.Address <> addr

    End If
Next
End Sub