2

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

无论如何，从一个列表到另一个列表有很多循环和跳转。如果我正常运行用户窗体，它会无限循环。它似乎运行了一次，然后就像用户一遍又一遍地再次单击列表中的同一项目一样。

奇怪的是，如果我单步执行代码（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 的一个列表... Model 将是 Malibu、Focus、Civic 的另一个列表...但您也将拥有 Color Blue、Red、Green... 所以如果您的用户想要绿色汽车，该程序引用一个库存清单，并摆脱任何品牌，型号等......绿色不可用。同样，用户可以从 Model 列表中单击 Civic，它会从 Make 中淘汰除 Honda 之外的所有车型，依此类推。无论如何，这就是我想要做的。

4

1 回答 1

1

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

于 2012-07-14T21:11:54.397 回答