0

VBAフォームに3つのドロップダウン（cbo_fac1、cbo_fac2、cbo_fac3）があり、それぞれが同じソースからデータを抽出しています。ただし、選択リストのグループにカスケード更新を実装して、ユーザーが1つのオプションからオプションを選択すると、後続の選択リストから削除されるようにしたいと思います。

たとえば、cbo_fac1に次のオプションがある場合：

Blu-ray DVD Player
Chalk board
Computer 
Data projector
Data projector trolley

ユーザーがcbo_fac1Blu-ray DVD Playerから選択すると、次の2つのドロップダウン（cbo_fac2とcbo_fac3）で使用できるオプションは次のとおりです。

Chalk board
Computer 
Data projector
Data projector trolley

次に、ユーザーがcbo_fac2Data projector trolleyから選択することを決定した場合、次の最後のドロップ（cbo_fac3）には、次の選択オプションのみが必要です。

Chalk board
Computer 
Data projector

もちろん、ユーザーが戻ってオプションを変更することを決定した場合、これも反映する必要があります。これを達成するにはどうすればよいでしょうか。これは私がこれまでに持っているコードです：

   For Each c_fac In ws_misc.Range("fac")
        With Me.cbo_fac1
        .AddItem c_fac.Value
        .List(.ListCount - 1, 1) = c_fac.Offset(0, 1).Value
         End With
        With Me.cbo_fac2
        .AddItem c_fac.Value
        .List(.ListCount - 1, 1) = c_fac.Offset(0, 1).Value
        End With
        With Me.cbo_fac3
        .AddItem c_fac.Value
        .List(.ListCount - 1, 1) = c_fac.Offset(0, 1).Value
        End With
      Next c_fac

前もって感謝します！

4

1 に答える 1

1

思ったより時間がかかりました。簡単になると思いました:)

このソリューションでは、VBAでユーザー定義型を使用します。この例を参照してください。

これをモジュールに入れます：

Option Explicit

Public Type listOptions
    name As String
    isUsed As Boolean
End Type

ユーザーフォームに3つのコンボボックスを追加します。コンボボックスをcbo_fac1、cbo_fac2、cbo_fac3という名前に変更します。

次に、ユーザーフォームの後ろに次のコードを追加します。

Option Explicit

' options needs to be persisted throughout the life of the program
Dim options() As listOptions

Private Sub UserForm_Initialize()
    ' setup options
    Call getOptionsFromWorksheet("Sheet1")

    fillComboBoxWithOptions "cbo_fac1"
    fillComboBoxWithOptions "cbo_fac2"
    fillComboBoxWithOptions "cbo_fac3"
End Sub

Private Sub getOptionsFromWorksheet(ByRef wsName As String)
    Dim ws As Excel.Worksheet
    Set ws = ThisWorkbook.Worksheets(wsName)

    ' assuming data begins at A1
    Dim lastCell As Long
    Dim i As Long

    lastCell = ws.Cells.SpecialCells(xlCellTypeLastCell).Row

    ReDim options(lastCell - 1)

    For i = 1 To lastCell
        options(i - 1) = createOption(ws.Cells(i, 1).Value)
    Next
End Sub

Private Function createOption(ByRef theName) As listOptions
    Dim opt As listOptions
    opt.name = theName
    opt.isUsed = False
    createOption = opt
End Function


Private Sub cbo_fac1_AfterUpdate()
    Call resetSelectedOptions

    ' reset other combo boxes with options
    fillComboBoxWithOptions "cbo_fac2"
    fillComboBoxWithOptions "cbo_fac3"
End Sub

Private Sub cbo_fac2_AfterUpdate()
    Call resetSelectedOptions

    ' reset other combo boxes with options
    fillComboBoxWithOptions "cbo_fac1"
    fillComboBoxWithOptions "cbo_fac3"
End Sub

Private Sub cbo_fac3_AfterUpdate()
    Call resetSelectedOptions

    ' reset other combo boxes with options
    fillComboBoxWithOptions "cbo_fac1"
    fillComboBoxWithOptions "cbo_fac2"
End Sub

' Resets the combobox control with the available options
Private Sub fillComboBoxWithOptions(ByRef comboBoxName)
    Dim selectedItem As String

    ' get and store the selected item, if any,
    ' so we can re-select it after we clear it out and re-fill it
    If (Me.Controls(comboBoxName).ListIndex <> -1) Then
        selectedItem = Me.Controls(comboBoxName).List(Me.Controls(comboBoxName).ListIndex)
    End If

    Me.Controls(comboBoxName).Clear
    Dim i As Long
    For i = 0 To UBound(options)
        If (options(i).name = selectedItem) Then
            Me.Controls(comboBoxName).AddItem options(i).name
        ElseIf (Not options(i).isUsed) Then
            Me.Controls(comboBoxName).AddItem options(i).name
        End If
    Next

    ' re-select the item
    For i = 0 To Me.Controls(comboBoxName).ListCount - 1
        If (Me.Controls(comboBoxName).List(i) = selectedItem) Then
            Me.Controls(comboBoxName).ListIndex = i
            Exit For
        End If
    Next
End Sub

Private Sub resetSelectedOptions()
    Dim i As Long
    For i = 0 To UBound(options)
        options(i).isUsed = False
    Next

    ' Since the list index will not match the index of the options() array
    ' we have to loop through until we find a matching name and set
    ' the isUsed = True
    If (cbo_fac1.ListIndex <> -1) Then
        For i = 0 To UBound(options)
            If (options(i).name = cbo_fac1.List(cbo_fac1.ListIndex)) Then
                options(i).isUsed = True
                Exit For
            End If
        Next
    End If

    If (cbo_fac2.ListIndex <> -1) Then
        For i = 0 To UBound(options)
            If (options(i).name = cbo_fac2.List(cbo_fac2.ListIndex)) Then
                options(i).isUsed = True
                Exit For
            End If
        Next
    End If


    If (cbo_fac3.ListIndex <> -1) Then
        For i = 0 To UBound(options)
            If (options(i).name = cbo_fac3.List(cbo_fac3.ListIndex)) Then
                options(i).isUsed = True
                Exit For
            End If
        Next
    End If

End Sub

ここでの考え方は、各コンボボックスに値が選択された後、AferUpdateイベントを使用して他のコンボボックスをリセットするというものです。コンボボックスにすでに値が選択されているかどうかも考慮されます。

お役に立てれば

編集：ワークシートのデータに対応するようにコードを変更しました。シートに「Sheet1」という名前を付けました（これを必要なものに変更します）。そのワークシートでは、リストしたいアイテムのリストがデータのみであると想定しています（つまり、ヘッダーやその他のデータはありません）。ワークシート）。

于 2012-10-18T14:13:46.770 に答える