Excel VBA 中的多个相关下拉列表
Multiple Dependent Drop-Down List in Excel VBA
我是 VBA 的新手,我在创建多个下拉列表时遇到了一些麻烦。我正在处理的工作簿的两个 sheet 显示在此 post 中链接的图像中。
[1]: https://i.stack.imgur.com/BBIA1.png
[2]: https://i.stack.imgur.com/2Gkxb.png
所以基本上我要做的是在“FORM”sheet 中为单元格 B6 创建一个下拉列表,它是从“LISTS”[=] 中的单元格 A2:A4 中提取的25=]。根据在单元格 B6 中选择的内容,将为“表单”sheet 中的单元格 D6 创建一个下拉列表(从“LISTS”sheet 中提取)。这里需要注意的是,如果从“FORM”sheet 单元格 B6 的下拉列表中选择“PART”,而不是在 D6 中生成下拉列表,我希望单元格显示“N/A" 代替。下面显示的是我尝试编写的代码。
Sub PRODUCT_LIST()
Dim FORM As Worksheet
Dim LISTS As Worksheet
Dim PRODUCT As Range
Dim PRODUCT_LIST As Range
Dim MODEL As Range
Dim BIKE_LIST As Range
Dim CHAIR_LIST As Range
Set FORM = ThisWorkbook.Worksheets("FORM")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
Set PRODUCT = FORM.Range("B6")
Set MODEL = FORM.Range("D6")
Set PRODUCT_LIST = LISTS.Range("A2:A4")
Set BIKE_LIST = LISTS.Range("B2:B8")
Set CHAIR_LIST = LISTS.Range("C2:C3")
With PRODUCT.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & PRODUCT_LIST.Address
End With
If PRODUCT.Value = "BIKE" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & CHAIR_LIST.Address
End With
ElseIf PRODUCT.Value = "CHAIR" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & BIKE_LIST.Address
End With
ElseIf PRODUCT.Value = "PART" Then
MODEL.Value = "N/A"
Else
End If
End Sub
这段代码没有按照我想要的方式工作,我不确定我做错了什么。 B6 的下拉列表工作得很好,但 D6 的下拉列表似乎忽略了我放置的条件。无论我在 B6 的下拉列表中选择什么,D6 的下拉列表总是从 CHAIR_LIST 拉取。任何帮助,将不胜感激。谢谢。
您没有回答澄清问题...
请尝试下一个方法:
- 首先,您需要为第一个单元格创建验证。仅一次,或在需要时修改列表内容。请复制标准模块中的下一个代码:
Sub PRODUCT_LIST()
Dim FORM As Worksheet, LISTS As Worksheet
Set FORM = ThisWorkbook.Worksheets ("FORM")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
With FORM.Range("B6").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & "A2:A4"
End With
End Sub
- 请复制
FORM
sheet 代码模块中的下一个代码。右键单击 sheet 名称,然后选择 View Code
:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "B6" Then
Dim MODEL As Range, LISTS As Worksheet, BIKE_LIST As Range, CHAIR_LIST
Set MODEL = Me.Range("D6")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
Set BIKE_LIST = LISTS.Range("B2:B8")
Set CHAIR_LIST = LISTS.Range("C2:C3")
Application.EnableEvents = False
If Target.value = "BIKE" Then
With MODEL.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & BIKE_LIST.Address
End With
MODEL.value = ""
ElseIf Target.value = "CHAIR" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & CHAIR_LIST.Address
End With
MODEL.value = ""
ElseIf Target.value = "PART" Then
MODEL.value = "N/A"
Else
End If
Application.EnableEvents = True
End If
End Sub
如果在更改 MODEL
验证列表后您需要从该列表中放置一个值(假设是第一个),则可以轻松完成...
我是 VBA 的新手,我在创建多个下拉列表时遇到了一些麻烦。我正在处理的工作簿的两个 sheet 显示在此 post 中链接的图像中。 [1]: https://i.stack.imgur.com/BBIA1.png [2]: https://i.stack.imgur.com/2Gkxb.png
所以基本上我要做的是在“FORM”sheet 中为单元格 B6 创建一个下拉列表,它是从“LISTS”[=] 中的单元格 A2:A4 中提取的25=]。根据在单元格 B6 中选择的内容,将为“表单”sheet 中的单元格 D6 创建一个下拉列表(从“LISTS”sheet 中提取)。这里需要注意的是,如果从“FORM”sheet 单元格 B6 的下拉列表中选择“PART”,而不是在 D6 中生成下拉列表,我希望单元格显示“N/A" 代替。下面显示的是我尝试编写的代码。
Sub PRODUCT_LIST()
Dim FORM As Worksheet
Dim LISTS As Worksheet
Dim PRODUCT As Range
Dim PRODUCT_LIST As Range
Dim MODEL As Range
Dim BIKE_LIST As Range
Dim CHAIR_LIST As Range
Set FORM = ThisWorkbook.Worksheets("FORM")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
Set PRODUCT = FORM.Range("B6")
Set MODEL = FORM.Range("D6")
Set PRODUCT_LIST = LISTS.Range("A2:A4")
Set BIKE_LIST = LISTS.Range("B2:B8")
Set CHAIR_LIST = LISTS.Range("C2:C3")
With PRODUCT.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & PRODUCT_LIST.Address
End With
If PRODUCT.Value = "BIKE" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & CHAIR_LIST.Address
End With
ElseIf PRODUCT.Value = "CHAIR" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.Name & "'!" & BIKE_LIST.Address
End With
ElseIf PRODUCT.Value = "PART" Then
MODEL.Value = "N/A"
Else
End If
End Sub
这段代码没有按照我想要的方式工作,我不确定我做错了什么。 B6 的下拉列表工作得很好,但 D6 的下拉列表似乎忽略了我放置的条件。无论我在 B6 的下拉列表中选择什么,D6 的下拉列表总是从 CHAIR_LIST 拉取。任何帮助,将不胜感激。谢谢。
您没有回答澄清问题...
请尝试下一个方法:
- 首先,您需要为第一个单元格创建验证。仅一次,或在需要时修改列表内容。请复制标准模块中的下一个代码:
Sub PRODUCT_LIST()
Dim FORM As Worksheet, LISTS As Worksheet
Set FORM = ThisWorkbook.Worksheets ("FORM")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
With FORM.Range("B6").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & "A2:A4"
End With
End Sub
- 请复制
FORM
sheet 代码模块中的下一个代码。右键单击 sheet 名称,然后选择View Code
:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "B6" Then
Dim MODEL As Range, LISTS As Worksheet, BIKE_LIST As Range, CHAIR_LIST
Set MODEL = Me.Range("D6")
Set LISTS = ThisWorkbook.Worksheets("LISTS")
Set BIKE_LIST = LISTS.Range("B2:B8")
Set CHAIR_LIST = LISTS.Range("C2:C3")
Application.EnableEvents = False
If Target.value = "BIKE" Then
With MODEL.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & BIKE_LIST.Address
End With
MODEL.value = ""
ElseIf Target.value = "CHAIR" Then
With MODEL.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & LISTS.name & "'!" & CHAIR_LIST.Address
End With
MODEL.value = ""
ElseIf Target.value = "PART" Then
MODEL.value = "N/A"
Else
End If
Application.EnableEvents = True
End If
End Sub
如果在更改 MODEL
验证列表后您需要从该列表中放置一个值(假设是第一个),则可以轻松完成...