無盡的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時使其退出循環。