当用户在另一个下拉列表中进行更改时,更改一个下拉列表的值

时间:2018-04-05 11:13:07

标签: excel vba excel-vba excel-2010

在Excel中,我希望当用户从另一个下拉列表中选择项目时,下拉列表的显示/选定值会发生变化。 (我已经可以更改列表中的选项)

背景:

List1是一个下拉列表,其中包含以下可用条目:

Product1                     
Product2                   

List2是一个下拉列表,其中包含以下可用条目(这些是付款期):

6  (available for Product1 and Product2)
10 (available for Product1 and Product2)
3  (available for Product2)
16 (available for Product2)
20 (available for Product2)

到目前为止,当List2中的所选项目发生变化时,我已设法更新List1中的可用下拉条目。但只有下拉条目才会改变; List2的实际当前可见内容不会更改。

问题:

这还不是我想要的:只要List1中的所选项目发生变化,List2就会立即显示"请选择" (除了List2's可用的下拉条目正在更新之外),因此用户知道必须在List2中进行选择。

2 个答案:

答案 0 :(得分:1)

利用Worksheet_Change事件并使用Intersect仅触发特定单元格。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("List1")) Is Nothing Then
        Application.EnableEvents = False 'prevent triggering another change event
        Range("List2").Value = "Please Select …"
        Application.EnableEvents = True
    End If
End Sub

注意应更改Range("List1")以引用List1 DropDown的单元格。并Range("List2")相应地。

答案 1 :(得分:0)

此代码将根据您在List1

中选择的值更新下拉列表
    Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim MyCell As Range

Set MyCell = Range("A1") 'Change A1 by cell where you have List1 dropwdown list

If Target.Address <> MyCell.Address Then
    'we do nothing
    Set MyCell = Nothing
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
Else
    'we modify List2 dropdown list
    Dim MyOption As String
    MyOption = MyCell.Value
    Set MyCell = Nothing
    Set MyCell = Range("B1") 'Change B2 by Cell where you have List2 dropwdown list

    'now 'We use Select Case because you can add all cases you want, just in case in Future you have, for example, Product3
    Select Case MyOption
        Case "Product1"
            With MyCell.Validation
                .Delete
                MyCell.Value = "Please Select"
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="6,10"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        Case "Product2"
            With MyCell.Validation
                .Delete
                MyCell.Value = "Please Select"
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="6,10,3,16,20"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
            Case Else
                MsgBox "Update code with new option"
    End Select
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

它对我有用:

enter image description here

更新后的代码:在问题清除后添加了“请选择”部分。