0

別のユーザー選択に基づいてドロップダウンリストを埋めたい。それに関連するものはオンラインで見つかりません。

次のテーブルを含むlookupDeptというワークブックがあります。

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

ここで、列 Aには定義された名前deptCodeがあり、列 Bには定義された名前deptNameがあります。次のテーブルを含むlookupModuleという 2 番目のワークブックがあります。

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 に答える