无休止的VBA循环，除非我单步执行代码

Question

我有一个包含6个列表对象的userform。所有列表对象都已命名range RowSources。单击任何一个列表中的任何一个项目都将引用电子表格上的图表，并清除任何项目单元格中不属于所选内容的内容（如果您感兴趣，请在下面进行更好的解释）。我的所有列表对象只有“更新后”触发器，其他的都由私有子程序处理。

不管怎么说，有很多列表之间的循环和跳转。如果我正常运行userform，它会无休止地循环。它似乎运行了一次，然后就像用户再次单击列表中的同一项一样，一次又一次。

奇怪的是，如果我单步执行代码(F8)，它会完美地结束，当它应该这样做并且控制权返回给用户时。

有没有人想过为什么会这样？

编辑：我最初没有发布代码，因为它基本上都是一个循环，有150多行。我不明白，如果单步执行使其工作完美，但允许其正常运行使其无休止地循环，那么它怎么会是代码。总之，代码如下：

Option Explicit
    Dim arySelected(6) As String
    Dim intHoldCol As Integer, intHoldRow As Integer
    Dim strHold As String
    Dim rngStyleFind As Range, rngStyleList As Range

Private Sub UserForm_Activate()
    Set rngStyleList = Range("Lists_W_Style")
    Set rngStyleFind = Range("CABI_FindStyle")
End Sub
Private Sub lstStyle_AfterUpdate()
    If lstStyle.ListIndex >= 0 Then
        arySelected(0) = lstStyle.Value
        Call FilterCabinetOptions(Range("Lists_W_Style"), Range("CABI_FindStyle"), 0)
    End If
End Sub
Private Sub lstWood_AfterUpdate()
    If lstWood.ListIndex >= 0 Then
        arySelected(1) = lstWood.Value
        Call FilterCabinetOptions(Range("Lists_W_Wood"), Range("CABI_FindWood"), 1)
'        lstWood.RowSource = "Lists_W_Wood"
    End If
End Sub
Private Sub cmdReset_Click()
    Range("Lists_S_Style").Copy Destination:=Range("Lists_W_Style")
    Call RemoveXes(Range("Lists_W_Style"))
    Range("Lists_S_Wood").Copy Destination:=Range("Lists_W_Wood")
    Call RemoveXes(Range("Lists_W_Wood"))
    Range("Lists_S_Door").Copy Destination:=Range("Lists_W_Door")
    Call RemoveXes(Range("Lists_W_Door"))
    Range("Lists_S_Color").Copy Destination:=Range("Lists_W_Color")
    Call RemoveXes(Range("Lists_W_Color"))
    Range("Lists_S_Glaze").Copy Destination:=Range("Lists_W_Glaze")
    Call RemoveXes(Range("Lists_W_Glaze"))
    Range("Lists_S_Const").Copy Destination:=Range("Lists_W_Const")
    Call RemoveXes(Range("Lists_W_Const"))
    Range("Lists_S_DrawFrontConst").Copy Destination:=Range("Lists_W_DrawFrontConst")
    Call RemoveXes(Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FilterCabinetOptions(rngList As Range, rngFind As Range, intAry As Integer)
    Dim intListCntr As Integer, intFindCntr As Integer, intStyleCntr As Integer
    If intAry = 0 Then
        Call FindStyle(arySelected(intAry))
    Else
        'Save the List item.
        For intListCntr = 1 To rngList.Rows.Count
            If rngList.Cells(intListCntr, 1) = arySelected(intAry) Then
                rngList.Cells(intListCntr, 3) = "X"
'                Call RemoveNonXes(rngList)
                Exit For
            End If
        Next intListCntr
        'Save the column of the Find List.
        For intFindCntr = 1 To rngFind.Columns.Count
            If rngFind.Cells(1, intFindCntr) = arySelected(intAry) Then
                'Minus 2 to allow for columns A and B when using Offset in the below loop.
                intHoldCol = rngFind.Cells(1, intFindCntr).Column - 2
                Exit For
            End If
        Next intFindCntr
        'Find appliciple styles.
        For intStyleCntr = 1 To rngStyleFind.Rows.Count
            If Len(rngStyleFind.Cells(intStyleCntr, intHoldCol)) > 0 Then
                Call FindStyle(rngStyleFind.Cells(intStyleCntr, 1))
            End If
        Next intStyleCntr
    End If
    Call RemoveNonXes(rngStyleList)
    Call RemoveNonXes(Range("Lists_W_Wood"))
    Call RemoveNonXes(Range("Lists_W_Door"))
    Call RemoveNonXes(Range("Lists_W_Color"))
    Call RemoveNonXes(Range("Lists_W_Glaze"))
    Call RemoveNonXes(Range("Lists_W_Const"))
    Call RemoveNonXes(Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FindStyle(strFindCode As String)
    Dim intListCntr As Integer, intFindCntr As Integer
    For intListCntr = 1 To rngStyleList.Rows.Count
        If rngStyleList.Cells(intListCntr, 1) = strFindCode Then
            rngStyleList.Range("C" & intListCntr) = "X"
            Exit For
        End If
    Next intListCntr
    For intFindCntr = 1 To rngStyleFind.Rows.Count
        If rngStyleFind.Cells(intFindCntr, 1) = strFindCode Then
            intHoldRow = rngStyleFind.Cells(intFindCntr).Row
            Exit For
        End If
    Next intFindCntr
    If Len(arySelected(1)) = 0 Then Call FindStyleOptions(Range("CABI_FindWood"), Range("Lists_W_Wood"))
    If Len(arySelected(2)) = 0 Then Call FindStyleOptions(Range("CABI_FindDoor"), Range("Lists_W_Door"))
    If Len(arySelected(3)) = 0 Then Call FindStyleOptions(Range("CABI_FindColor"), Range("Lists_W_Color"), Range("Lists_W_Wood"))
    If Len(arySelected(4)) = 0 Then Call FindStyleOptions(Range("CABI_FindGlaze"), Range("Lists_W_Glaze"), Range("Lists_W_Wood"))
    If Len(arySelected(5)) = 0 Then Call FindStyleOptions(Range("CABI_FindConst"), Range("Lists_W_Const"))
    If Len(arySelected(6)) = 0 Then Call FindStyleOptions(Range("CABI_FindDrawFrontConst"), Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FindStyleOptions(rngFind As Range, rngList As Range, Optional rngCheckList As Range)
    Dim intListCntr As Integer, intFindCntr As Integer
    Dim intStrFinder As Integer, intCheckCntr As Integer
    Dim strHoldCheck As String
    Dim strHoldFound As String, strHoldOption As String
    'Go through the appropriate find list (across the top of CABI)
    For intFindCntr = 1 To rngFind.Columns.Count
        strHoldOption = rngFind.Cells(1, intFindCntr)
        strHoldFound = rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0)
        If Len(strHoldFound) > 0 Then
            If rngCheckList Is Nothing Then
                For intListCntr = 1 To rngList.Rows.Count
                    If rngList.Cells(intListCntr, 1) = strHoldFound Then
                        Call AddXes(rngList, strHoldFound, "X")
                        Exit For
                    End If
                Next intListCntr
            Else
                intStrFinder = 1
                Do While intStrFinder < Len(rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0))
                    strHoldCheck = Mid(rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0), intStrFinder, 2)
                    intStrFinder = intStrFinder + 3
                    For intCheckCntr = 1 To rngCheckList.Rows.Count
                        If strHoldCheck = rngCheckList(intCheckCntr, 1) And Len(rngCheckList(intCheckCntr, 3)) > 0 Then
                            Call AddXes(rngList, strHoldOption, "X")
                            intStrFinder = 99
                            Exit For
                        End If
                    Next intCheckCntr
                Loop
            End If
        End If
    Next intFindCntr
End Sub
Private Sub AddXes(rngList As Range, strToFind As String, strX As String)
    Dim intXcntr As Integer
    For intXcntr = 1 To rngList.Rows.Count
        If rngList.Cells(intXcntr, 1) = strToFind Then
            rngList.Cells(intXcntr, 3) = strX
            Exit For
        End If
    Next intXcntr
End Sub
Private Sub RemoveNonXes(rngList As Range)
    Dim intXcntr As Integer
    For intXcntr = 1 To rngList.Rows.Count
        If Len(rngList(intXcntr, 3)) = 0 Then
            rngList.Range("A" & intXcntr & ":B" & intXcntr) = ""
        Else
            rngList.Range("C" & intXcntr) = ""
        End If
    Next intXcntr
End Sub
Private Sub RemoveXes(rngList As Range)
    rngList.Range("C1:C" & rngList.Rows.Count) = ""
End Sub

Answer 1

没有看到代码就很难分辨。当您运行脚本时，'AfterUpdate'事件可能会被反复触发，从而导致无休止的循环。尝试使用计数器将更新限制为一个更改，并在计数器大于0时退出循环。