根据另一个选择列表动态更新选择列表

Question

我希望根据另一个用户选择填写下拉列表。在网上找不到与之相关的任何内容。

我有一个名为 lookupDept 的工作簿，其中包含下表：

A   B
==  ==============================
BS  Business School
CG  Chemical Engineering

其中列A 具有已定义的名称 deptCode ，而列B 具有已定义的名称 deptName 。我有第二个名为 lookupModule 的工作簿，其中包含下表：

A       B                                                   C
======  ==================================================  ==
BSA005  Organisational Behaviour                            BS
BSA007  Skills for Study                                    BS
CGA001  Fluid Mechanics I MEng & BEng Status                CG
CGA002  Stagewise Processes                                 CG

我正在尝试更新表单上的 cbo_moduleCode 以选择 lookupDept 中列A 与列C <匹配的范围< / em>在 lookupModule 中。这是我正在使用的代码：

因此，如果用户在表单上选择 BS - Business School （从 lookupDept 工作簿中提取，我希望所有包含 BS的字段在 lookupModule 工作簿的C列中选中。这是我到目前为止使用的代码：

Private Sub UserForm_Initialize()

    Dim c_deptCode As Range
    Dim c_deptName As Range

    Dim deptCodes As Variant
    Dim deptNames As Variant

    Dim ws_dept As Worksheet
    Dim ws_misc As Worksheet
    Set ws_dept = Worksheets("lookupDept")
    Set ws_misc = Worksheets("lookupMisc")

    ' Assign each range to an array containing the values
    deptCodes = Choose(1, ws_dept.Range("deptCode"))
    deptNames = Choose(1, ws_dept.Range("deptName"))

    ' Create deptcode+deptname cbo
    For i = 1 To ws_dept.Range("deptCode").Rows.Count
        CombinedName = deptCodes(i, 1) & " - " & deptNames(i, 1)
        cbo_deptCode.AddItem CombinedName
    Next i

End Sub

Answer 1

选择第一个组合框后，您可以尝试即时添加项目。此代码是一个可能引导您朝着正确方向前进的示例：

Private Sub cbo_deptCode_Change()
Dim lLoop As Long, rgLoop As range

For lLoop = 1 To Me.cbo_moduleCode.ListCount

    Me.cbo_moduleCode.RemoveItem 0

Next lLoop

Sheets("lookupModule").[a1].CurrentRegion.AutoFilter
Sheets("lookupModule").[a1].CurrentRegion.AutoFilter Field:=3, Criteria1:=Left(Me.cbo_deptCode.Value, 2)

For Each rgLoop In Sheets("lookupModule").[a1].CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Columns(1).Cells
    If Len(rgLoop) > 0 Then
        Me.cbo_moduleCode.AddItem rgLoop & " - " & rgLoop.Offset(, 1)
    End If
Next rgLoop

End Sub