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 の 1 つのリストになります... Model は、Malibu、Focus、Civic の別のリストになります...しかし、Color Blue、Red、Green もあるでしょう...したがって、ユーザーが Green を希望する場合車、プログラムは在庫リストを参照し、緑で利用できないメーカー、モデルなどを取り除きます。同様に、ユーザーが Model リストから Civic をクリックすると、Honda 以外のすべてが Make から削除されます。それがとにかくやろうとしていることです。

4

1 に答える 1

1

コードを見ないとわかりにくいです。スクリプトを実行すると、「AfterUpdate」イベントが何度もトリガーされ、無限ループが発生する場合があります。カウンタを使用して更新を 1 つの変更に制限し、カウンタが 0 より大きくなったらループを終了するようにしてください。

于 2012-07-14T21:11:54.397 に答える