繁体   English   中英

Excel中的动态DropDown

[英]Dynamic DropDown in excel

我想创建一个州,区,分区等的下拉列表。通过从drpoDown状态列表中选择一个州,“区”下拉列表应仅包含属于该特定州的区列表。 如何使用vba代码做到这一点。 真的有可能吗?

假设我们根据H列中的值在B2单元格中具有主下拉列表:

在此处输入图片说明

包含了二次下拉信息逗号在一个单元格分隔的列表,每个列表。 下面的事件宏将检测到单元格B2的更改,并相应地在单元格C2中建立DV。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant, r As Range
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    If Range("B2").Value = "" Then Exit Sub
    Application.EnableEvents = False

    v = Target.Value
    Set r = Range("H3:H5").Find(What:=v, After:=Range("H3")).Offset(0, 1)
    v = r.Value

    With Range("C2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=v
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
    End With
    Application.EnableEvents = True
End Sub

因为它是工作表代码,所以非常易于安装和自动使用:

  1. 右键单击Excel窗口底部附近的选项卡名称
  2. 选择查看代码-这将打开一个VBE窗口
  3. 将内容粘贴并关闭VBE窗口

如果您有任何疑问,请先在试用版工作表上尝试一下。

如果您保存工作簿,则宏将随其一起保存。 如果您在2003年以后使用Excel版本,则必须将文件另存为.xlsm而不是.xlsx

删除宏:

  1. 如上调出VBE窗口
  2. 清除代码
  3. 关闭VBE窗口

要总体上了解有关宏的更多信息,请参见:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

要了解有关事件宏(工作表代码)的更多信息,请参见:

http://www.mvps.org/dmcritchie/excel/event.htm

必须启用宏才能使其正常工作!

这是C2下拉菜单的显示方式:

在此处输入图片说明

这是一个有点粗糙的主意...尝试一下-我已经在sheet2中进行了全部设计,首先创建数据

[A1]    [B1]    [C1]
State   Dist    SubDist
State1  Dist1   SD1
State1  Dist1   SD1
State1  Dist1   SD1
State1  Dist1   SD2
State1  Dist1   SD2
State1  Dist2   SD1
State1  Dist2   SD1
State1  Dist2   SD2
State1  Dist2   SD2
State1  Dist2   SD2
State1  Dist3   SD3
State1  Dist3   SD3
State2  Dist1   SD1
State2  Dist1   SD1
State2  Dist1   SD1
State2  Dist1   SD2
State2  Dist1   SD2
State2  Dist2   SD1
State2  Dist2   SD1
State2  Dist2   SD2
State2  Dist2   SD2
State2  Dist2   SD2
State2  Dist3   SD3
State2  Dist3   SD3

提前过滤器的克里特标准[J1] [K1] [L1] State Dist SubDist State1 Dist1

首先在下拉菜单1'drpState'中添加唯一状态值,并将getDist()分配给下拉菜单以进行状态选择(为其他选择项(例如dist,sub dist等)增加2。

创建3个下拉菜单'drpState'[宏:getDist()],'drpDist'[宏:getSDist()],'drpSDist'

Sub getDist()'<< Assign to State Selection
    Call GetDropdownValue("drpState", Sheet2.Range("J2"))
    Sheet2.Range("J1").CurrentRegion.Offset(1, 1).Clear
    Call GetSubList("drpDist", 2, Sheet2.Range("O1"))
End Sub

Sub getSDist() '<< Assign to Destic Selection
    Call GetDropdownValue("drpDist", Sheet2.Range("K2"))
    Call GetSubList("drpSDist", 3, Sheet2.Range("O1"))
End Sub

Sub GetDropdownValue(ByVal DropdownName As String, OutPutRange As Range)
    With Sheet2.DropDowns(DropdownName)
        OutPutRange.Value = .List(.ListIndex)
    End With
End Sub

Sub GetSubList(ByVal DropdownName As String, ByVal intLevel As Integer, ByVal OutPutRange As Range)

    Dim rngMainData As Range
    Dim rngList     As Range

    If OutPutRange.Value <> vbNullString Then
        OutPutRange.CurrentRegion.Clear
    End If

    Set rngMainData = Sheet2.Range("A1").CurrentRegion.Columns(1).Resize(, intLevel)
    rngMainData.AdvancedFilter xlFilterCopy, Sheet2.Range("J1").CurrentRegion.Columns(1).Resize(, intLevel), OutPutRange, True

    With OutPutRange.CurrentRegion.Columns(intLevel)
        Set rngList = .Offset(1).Resize(.Rows.Count - 1)
    End With

    With Sheet2.DropDowns(DropdownName)
        .List = rngList.Value
    End With
End Sub

我认为这将帮助您解决查询...

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM