Question

我的VBA表单中有三个下拉列表（ cbo_fac1 ， cbo_fac2 ， cbo_fac3 ），每个都从同一个源提取数据。但是我想在选择列表组上实现级联更新，以便当用户从一个选项中选择一个选项时，它将从后续选择列表中删除。

例如，如果 cbo_fac1 具有以下选项：

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

并且用户从 cbo_fac1 中选择Blu-ray DVD Player，然后接下来的两个下拉菜单（ cbo_fac2 和 cbo_fac3 ）应该只有以下选项：

Chalk board
Computer 
Data projector
Data projector trolley

如果用户随后决定从 cbo_fac2 中选择Data 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

提前致谢！

Answer 1

这比我想象的要长。我认为这会更容易：）

我会在VBA中使用用户定义类型来获得此解决方案。请看这个例子：

将其放入模块中：

Option Explicit

Public Type listOptions
    name As String
    isUsed As Boolean
End Type

在用户表单上添加三个组合框。将组合框更改为名称：cbo_fac1，cbo_fac2，cbo_fac3。

然后在userform后面添加此代码：

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”（将其更改为您需要的任何内容），我假设在该工作表中，其中唯一的数据是您要列出的项目列表（因此，没有标题，也没有其他数据）根本就是工作表。

从后续下拉列表中删除基于另一个下拉列表中的选项

1 个答案: