Excel VBA依赖组合框

时间:2018-07-07 12:33:15

标签: excel vba combobox

在此网站http://www.thesmallman.com/blog/2016/9/15/dependent-and-non-dependent-comboboxes上,我找到了以下代码:

Option Explicit
Option Base 1

Private Sub Worksheet_Activate()
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet

Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet

Set rng = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

    For Each r In rng
        Dic(r.Value) = Empty
    Next

    With ComboBox1
        .ListFillRange = ""
            If .ListCount = 0 Then 'Take out to refresh
                .List = Application.Transpose(Dic.keys)
                .ListIndex = 0
            End If ' out to refresh
    End With
End Sub

Private Sub ComboBox1_Change() 'Funding Combo Box capital program yr
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim cb As ComboBox
Dim ar As Variant

Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet

ar = Array("All Sub Categories", "All Products")
Application.EnableEvents = False

Set rng = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Set sh = Sheet2 'Control Sheet

    For Each r In rng
        If r = ComboBox1 Then
            Dic(r.Offset(, 1).Value) = Empty
        End If
    Next

    With ComboBox2 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Categories", 0
        .ListIndex = 0
    End With
    'Add to cb 3 & 4
    For i = 3 To 4
      Dic.RemoveAll
        For Each r In rng
            If r = ComboBox1 Then
                Dic(r.Offset(, i - 1).Value) = Empty
            End If
        Next

        Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
        With cb 'Add data to the comboboxes
            .List = Application.Transpose(Dic.keys)
            .AddItem ar(i - 2), 0
            .ListIndex = 0
        End With
    Next i

    For i = 1 To 4 'Loop through the comboboxes
        Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
        sh.Cells(2, i + 1) = cb.Value
    Next i

Application.EnableEvents = True
End Sub

Private Sub ComboBox2_Change() 'Geography Program
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim i As Integer
Dim cb As ComboBox
Dim sh As Worksheet
Dim ws As Worksheet

Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet

Application.EnableEvents = False
Set rng = ws.Range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

    If ComboBox2 = "All Categories" Then
        For Each r In rng
            Dic(r.Offset(, 1).Value) = Empty
        Next

        Else
        'Only items that relate to Combo 2
        For Each r In rng
            If r = ComboBox2 Then
                Dic(r.Offset(, 1).Value) = Empty
            End If
        Next
    End If

    With ComboBox3 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Sub Categories", 0
        .ListIndex = 0
    End With

    Dic.RemoveAll
    'NEW
        'Only items that relate to Combo 2
        For Each r In rng
            If r = ComboBox2 Then
                Dic(r.Offset(, 2).Value) = Empty
            End If
        Next


    With ComboBox4 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Products", 0
        .ListIndex = 0
    End With

    sh.[c2] = ComboBox2.Value
    Application.EnableEvents = True
End Sub

Private Sub ComboBox3_Change()
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet

Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet

Application.EnableEvents = False
Set rng = ws.Range("C2", ws.Range("C" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

    If ComboBox3 = "All Sub Categories" Then
        For Each r In rng
            Dic(r.Offset(, 1).Value) = Empty
        Next

        Else
        'Only items that relate to Combo 3
        For Each r In rng
            If r = ComboBox3 Then
                Dic(r.Offset(, 1).Value) = Empty
            End If
        Next
    End If

    With ComboBox4
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Products", 0
        .ListIndex = 0
    End With
    sh.[D2] = ComboBox3.Value
Application.EnableEvents = True
End Sub

Private Sub ComboBox4_Change()
Dim sh As Worksheet
Set sh = Sheet2 'Control Sheet

    Application.EnableEvents = False
    sh.[E2] = ComboBox4.Value
    Application.EnableEvents = True

    End
End Sub

由于我是VBA的初学者,所以我了解一些代码,但不是全部。我想学习如何修改此代码以给我2个组合框,其中第二个组合框依赖于第一个组合框。我还想删除所有与第一和第二组合框的更新不直接相关的代码。这个线程很有趣:Excel Data Validation as input to another Data Validation

更新:

我上传了带有列表源的图像,绿色文本是非依赖下拉列表,红色文本是依赖下拉列表。 Image of my data layout

0 个答案:

没有答案
相关问题