没有命名范围的嵌套下拉列表

时间:2012-10-24 13:40:00

标签: excel vba drop-down-menu excel-vba

我是新手,所以请耐心等待。我在一张表中列出了一长串案例编号和相关名称,每个案例编号都有几个名称。在工作簿的各个位置,我希望用户从下拉列表中选择一个案例编号(可以使用动态命名范围),然后在另一个下拉列表中选择一个关联的名称。

因为案例编号太多而且它们发生了变化,所以我不能在第二个下拉列表中使用命名范围。是否有VBA方法可以做到这一点?

1 个答案:

答案 0 :(得分:0)

假设您的案例编号位于Sheet2的第1行,其相关名称位于每个案例编号下方,则您的案例编号下拉列表位于单元格B1中,而您的关联名称下拉列表位于单元格B2中(已定义)作为列表ListNames的数据验证),使用以下工作表宏来更新B2的数据验证

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rgNames As Range, rgFoundCase As Range

If Not Intersect(Target, [B1]) Is Nothing Then

    'turn off updates to speed up code execution
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Set rgFoundCase = Sheets("Sheet2").Rows(1).Find(What:=[B1], After:=Sheets("Sheet2").Cells(1, 1), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

    Set rgNames = rgFoundCase.Offset(1).Resize(rgFoundCase.End(xlDown).Row - 1)

    ActiveWorkbook.Names.Add Name:="ListNames", RefersTo:=rgNames

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With

End If

End Sub