将项目添加到“使用...结束时”时出现Excel错误91

Kalzin 发表于 Dev

钙化

我在Do / With函数下添加一个项目时会抛出错误91。（感谢克里斯·尼尔森的代码）

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，除非我丢失了某些内容，否则似乎并没有为我增加一个变量。有人有什么想法吗？

**注意：它会执行预期的操作，只会引发错误。

布雷特杰

清除单元格时，cl可能Nothing需要删除循环之外的范围，或添加测试Nothing

方法1将更快

方法1-删除单拍范围

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

方法2

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。