在此网站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