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

Question

我有一个用6个列表对象的用户窗体。所有列表对象都具有命名范围rowsources。点击任意一个列表中的任意一个项目将引用电子表格中的图表，并清除不属于所选内容的任何项目单元格的内容（如果您感兴趣，请在底部解释更好的内容）。我所有的列表对象都只有“更新后”触发器，其他所有内容都由私人潜艇处理。

无论如何，从列表到列表都有很多循环和跳跃。如果我正常运行用户窗体，它会无休止地循环。它似乎只运行一次，然后就好像用户再次单击列表中的同一项目一样。

奇怪的是，如果我逐句通过代码（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 

说明： 想象一下，你有6只列出不同的汽车条件。因此，Make将成为Chevy，Ford，Honda的一个名单...模特将会是Malibu，Focus，Civic的另一个......但是你也会有Color Blue，Red，Green ......所以如果你的用户想要一个Green汽车，该程序参考清单列表并摆脱任何制造商，型号等...不可用于绿色。同样，用户也可以点击车型列表中的Civic，它可以从Make中除去本田以外的所有其他车型，等等。无论如何，这正是我想要做的。

Answer 1

没有看到代码很难说。当您运行该脚本时，“AfterUpdate”事件可能会一遍又一遍地触发，导致无限循环。尝试使用计数器将更新限制为一次更改，并在计数器大于0时使其退出循环。