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

当我在Do / Withfunction下添加一个项目时，我有一个代码会引发错误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，除非我遗漏了一些东西，否则似乎没有在我的知识中添加一个variables。 任何人有任何想法？

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

Answer 1

当你清除单元格时， cl可能是Nothing所以你需要删除循环之外的范围，或者添加Nothing的testing

方法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 

Answer 2

试试这个代码。 我已经改变“循环while cl.Address <> addr”到“循环直到cl是没有”

 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