0

我想根据另一个用户的选择填写一个下拉列表。在网上找不到与它相关的任何东西。

我有一个名为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 列与lookupModule中的C列匹配。这是我正在使用的代码：

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

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
4

1 回答 1

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
于 2012-10-12T19:59:51.853 回答