excel - Excel VBA 相关组合框
问题描述
在这个网站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
更新:
我上传了一张带有列表来源的图片,绿色文本是非依赖下拉列表,红色文本是依赖下拉列表。我的数据布局图
解决方案
推荐阅读
- swift - 将字符串转换为 cllocationcoordinate2d swift 的数组
- python - 删除文本文件中的完整文本行(在 Python 上)
- reactjs - react-native:如何从公共 facebook 页面获取帖子?
- python - 同时处理多个图形时更改一个 Matplotlib 图形的样式
- php - symfony 4 - 自定义错误页面和自定义错误消息
- node.js - 在多个项目中使用相同模型的最佳实践是什么?
- angular - Jasmine:可观察到单元测试 http 服务错误
- tumblr - Tumblr:将内容添加到某个标签
- asp.net - 大文件流混淆
- ldap - 使用 CAS 的 LDAP 身份验证