0

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

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

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

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

Chalk board
Computer 
Data projector
Data projector trolley

如果用户随后决定Data projector trolley从cbo_fac2中进行选择，那么下一个也是最后一个下拉 ( 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

在用户窗体上添加三个组合框。将组合框更改为名称：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 回答