VBA循环第88次迭代失败
我有以下的Sub,如果它覆盖的范围less于88个单元,则工作正常,否则在第88次迭代时会失败。
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count = 1 And Target.Row >= 3 And Target.Row <= 30 And Target.Column >= 17 And Target.Column < 22 Then i = Target.Row Dim MergeGroups As Range Dim GroupTable As Range Dim rngStart As Range Dim rngEnd As Range Dim rngToCount As Range Dim CurrentGrp As Range Dim NextGrp As Range Dim NumVals As Integer Set MergeGroups = Range("A1:O1") Set GroupTable = Range("Q2:V2") Set CurrentGrp = Range(Cells(GroupTable.Row, ActiveCell.Column).Address) Set NextGrp = Range(Cells(GroupTable.Row, ActiveCell.Column + 1).Address) Set rngStart = MergeGroups.Find(CurrentGrp.Value) Set rngEnd = MergeGroups.Find(NextGrp.Value) Set rngToCount = Range(Cells(ActiveCell.Row, rngStart.Column), Cells(ActiveCell.Row, rngEnd.Column - 1)) ' rngToCount.Font.Bold = True NumVals = Application.WorksheetFunction.CountA(rngToCount) Cells(i, ActiveCell.Column).Value = NumVals ActiveCell.Offset(1, 0).Select Do While ActiveCell.Column < 21 ActiveCell.Offset(-28, 1).Select Loop End If End Sub
这是一个特定工作表中的一个对象,利用了SelectionChange
事件。 当它失败时,我收到错误消息:
运行时错误“-2147417848(80010108)”:对象'范围'的方法'查找'失败。
问题是与线:
Set rngStart = MergeGroups.Find(CurrentGrp.Value)
任何人都可以帮助我解决为什么Sub运行良好的小范围,但否则在一个特定的迭代失败?
感谢@ Mat的马克杯告诉我什么是错误的, 这个问题和帮助我说得对。 这是修改的代码:
Sub PleaseWorkThisTime() Dim MergeGroups As Range Dim GroupTable As Range Dim GrpCounts As Range Dim rngStart As Range Dim rngEnd As Range Dim rngToCount As Range Dim CurrentGrp As Range Dim NextGrp As Range Dim NumVals As Integer Set MergeGroups = Range("A1:O1") Set GroupTable = Range("Q2:V2") Set GrpCounts = Range("Q3:U23") Dim GrpCount As Range For Each GrpCount In GrpCounts Set CurrentGrp = Range(Cells(GroupTable.Row, GrpCount.Column).Address) Set NextGrp = Range(Cells(GroupTable.Row, GrpCount.Column + 1).Address) Set rngStart = MergeGroups.Find(CurrentGrp.Value) Set rngEnd = MergeGroups.Find(NextGrp.Value) Set rngToCount = Range(Cells(GrpCount.Row, rngStart.Column), Cells(GrpCount.Row, rngEnd.Column - 1)) NumVals = Application.WorksheetFunction.CountA(rngToCount) GrpCount.Value = NumVals Next GrpCount End Sub