VBA 循环在第 88 次迭代左右失败答案

【问题标题】：VBA loop fails around 88th iterationVBA 循环在第 88 次迭代左右失败
【发布时间】：2017-05-09 22:30:46
【问题描述】：

我有以下 Sub，如果它覆盖的范围少于 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 在小范围内运行良好，但在特定迭代时会失败？

【问题讨论】：

每次选择循环中的另一个单元格时，您都在调用同一个 sub。您需要弄清楚如何在不使用 select 的情况下执行此操作，或者在执行循环时禁用事件并在退出子之前启用它们。
非常感谢@Mat'sMug！我必须承认我没有完全理解这个回复，但它让我朝着正确的方向前进 - this link 很有帮助，因为我无法理解 .Select 的邪恶之处。我想我现在已经可以工作了，一旦我正确测试了它，我就会在这里发布我的新代码。

标签： vba excel runtime-error

【解决方案1】：

感谢 @Mat's Mug 告诉我出了什么问题，感谢 this Q&A 帮助我纠正错误。这是修改后的代码：

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

【讨论】：