簡體   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