Question

我有一个包含6个列表对象的用户表单。所有列表对象都有命名范围行数据。单击任何一个列表中的任何一个项目将引用电子表格上的图表并清除任何项目单元格中不属于所选内容的内容（如果您感兴趣，可在此底部更好地解释）。我的所有列表对象都只有“After Update”触发器，其他所有内容都由私有子处理。

无论如何，从列表到列表有很多循环和跳转。如果我正常运行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

说明：想象一下，你有6个不同汽车条件的清单。所以Make将是雪佛兰，福特，本田的一个列表......模型将是另一个与Malibu，Focus，思域...但你也有颜色蓝色，红色，绿色...所以如果你的用户想要一个绿色汽车，该程序参考库存清单，摆脱任何制造，模型等...绿色不提供。同样，用户可以从“模型”列表中单击“思域”，它将从“制造”中消除除本田之外的所有内容，依此类推。这就是我想要做的事情。

Answer 1

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

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

1 个答案: