如何制作Excel一级，二级，三级及多级下拉菜单

Posted 2023-05-15

以WPS 2019版本为例：

关于excel表格怎样设置一级，二级，三级及多级下拉菜单，在WPS「表格（Excel）」中操作方法如下：

1、首先，我们在表格将数据分别录入到Sheet2和Sheet3中，Sheet2中是一级和二级，Sheet3中是二级和三级的数据。和之前制作二级下拉菜单的方式差不多，我们先进入Sheet2中，选择所有数据，点击「公式-指定-只保留「首行」前面的勾，其他的全部取消掉。同样的方法，我们再次进入Sheet3中进行操作；

2、设置一级下拉菜单：进入Sheet1，选中A2单元格，进入「数据-有效性-有效性-选择序列」，在「来源」中选择Sheet2中的「A1:C1」单元格（就是一级下拉菜单的内容）；

（注意：设置完成后续先选中一个选项，否则设置二级时会提示错误）

3、设置二级下拉菜单。光标定位到B2单元格，然后进入「数据-有效性-有效性-选择序列」「来源」中输入「=INDIRECT(A2)」确定；

4、设置三级下拉菜单。选中C2单元格，同样的操作，只是在「来源」中输入的是「=INDIRECT(B2)」。最后，我们选中A2:C2单元格，向下填充一下。此时，我们的多级下拉菜单就已经全部完成。 参考技术A 只通过公式和函数制作多级动态下拉菜单，请参考：
http://jingyan.baidu.com/article/a501d80c28a796ec630f5eb8.html 参考技术B Excel简单制作一级、二级、三级及多级下拉菜单_百度经验 http://jingyan.baidu.com/article/375c8e1997ca2e25f3a2295b.html

excel表VBA中用代码如何建立多级combobox下拉菜单

1，就是从range("C5:F" & [f65536].end(3).row)里提取数据，C列直接提取key 值给comboboxhd1.
2，运行后根据comboboxhd1的内容去查找C列中含有comboboxhd1的内容对应的D列单元格组成新的数组，成组将其唯一化后给comboboxcp1，形成二级下拉菜单；
3，根据comboboxcp1的内容去查找D列中含有comboboxcp1的内容对应的E列单元格组成新的数组将其唯一化后给comboxkf1，形成二级下拉菜单
4，(根据comboboxcp1的内容去查找D列和comboboxkf1的内容去查找E列)两个条件对应的F列单元格，形成三级下拉菜单，将其值唯一化给产品特性comboboxtx1
说明：comboboxhd1是厚度索引，我有几千条数据，分成十几类后，我找起来就非常容易
comboboxcp1是厚度分类后的产品品名，再唯一化，也就是十几类。也是为了方便查找
comboboxkf1是产品的宽幅，每个产品下只有几个宽幅，我只需要根据产品品名去查找
comboboxtx1是产品的特性，每个产品，不同宽幅，有不同特性。我将其引入做为三级下拉菜单
总思路是，我做流水帐时为防止我的仓库目录里没有而导致抓取数据不全，通过用户窗体将其用combobox来赋值，精准，且不用建附表，方便录入等。
Private Sub UserForm_Initialize()Dim i&, Myr&, arrDim d, kSet d = CreateObject("Scripting.Dictionary")Myr = Sheets("领退入汇总").[d65536].End(xlUp).Rowarr = Sheets("领退入汇总").Range("c6:d" & Myr)For i = 6 To UBound(arr)d(arr(i, 1)) = arr(i, 2)Nextk = d.KeysComboBoxhd1.List() = kComboBoxhd2.List() = kComboBoxhd3.List() = kComboBoxhd4.List() = kComboBoxhd5.List() = kComboBoxhd6.List() = kSet d = NothingEnd Sub第一段代码是这样的，得到的结果是如上图所示，comboboxhd1的值即key值杂乱无序，key可以排序吗，后面的二级和三级如何设置

　　ExcelVBA字典实现窗体二级下拉菜单：

　　问题提出:

　　选择确定ComboBox1中的数值后，ComboBox2的下拉列表自动引用ComboBox1中数值对应的列的内容。如何能做到，现在想在加一重判断：就是判断ComboBox2中的数值，如果是原来ComboBox1对应列中已有的值，就直接向下进行，如果原来ComboBox1对应列中没有该值，自动添加到该列最下一个非空行之后再向下执行。

　　字典的引用:

　　窗体代码如下:
Public Arr, Dic As New Dictionary    '声明为公共变量,引用“Microsoft Scripting Runtime”
Private Sub UserForm_Initialize() '窗体初始化事件
    Dim Brr
    Arr = Sheet1.Range("A1").CurrentRegion.Value    'A1单元格已用区域
    For i = 1 To UBound(Arr, 2)    '循环标题，并添加到字典
        If Not Dic.Exists(Arr(1, i)) Then    '字典中不存在关键字
            Dic.Add Arr(1, i), Dic.Count + 1    '添加关键字,Item为索引
        End If
    Next
    Brr = Dic.Keys
    Me.ComboBox1.Clear    '清除列表框1条目
    For i = 0 To UBound(Brr) - 1    '列表框1添加条目
        Me.ComboBox1.AddItem Brr(i)
    Next
End Sub
Private Sub ComboBox1_DropButtonClick() '列表框1下拉事件
    Dim Brr
    If Me.ComboBox1.Text = "" Then Exit Sub    '如果列表框1为空，就退出过程
    Me.ComboBox2.Clear    '清空列表框2条目
    If Dic.Exists(Me.ComboBox1.Text) Then '如果列表框的关键字,在字典中有记录
        Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text)) '用Index函数取出整列数据
        For i = 2 To UBound(Brr, 1)    '列表框2添加条目
            Me.ComboBox2.AddItem Brr(i, 1)    '列表框2添加条目
        Next
    End If
End Sub
Private Sub CommandButton1_Click() '按钮1单击事件
    If Me.ComboBox1.Text = "" Or Me.ComboBox2.Text = "" Then Exit Sub    '如果列表框1,2为空，就退出过程
    Dim Brr, Crr
    Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text))    '用Index函数取出整列数据
    Crr = VBA.Filter(Application.Transpose(Brr), Me.ComboBox2.Text, True)    '取出匹配列表框2的值
    If UBound(Crr) = -1 Then  '如果有列表框2的值,数组不会为-1  ,'如果列表框2中没有此关键字,往原数据添加此关键字
        Sheet1.Cells(Rows.Count, Dic(Me.ComboBox1.Text)).End(xlUp).Offset(1).Value = Me.ComboBox2.Text
    End If
    Sheet1.Cells(Rows.Count, 10).End(xlUp).Offset(1).Value = Me.ComboBox2.Text    '+ Me.ComboBox1.Text  '把数据写入单元格
    Me.ComboBox1.Text = "": Me.ComboBox2.Text = ""    '列表框1，2显示为空白
    Me.ComboBox1.Clear: Me.ComboBox2.Clear    '清空列表框1，2的条目
    Call UserForm_Initialize    '初始化窗体，为下一次录入数据准备
End Sub

　　效果图:

参考技术A 给你个思路：
for i=1 to 行数
if cells(i,"c")＝comboboxhd1值 then arr(n)=cells(i,"D"):n=n+1
next
数组下标可用表函数 countif 先计算
用redim 重定义
排序问题，可先对数组排序或者在添加到组合框时循环确定放置位置本回答被提问者采纳 参考技术B 很好做的，不管是前面单元格里面，还是VBA都比较好做，
不过快下班了，hoho~~~追问

麻烦你帮忙做下，感激不尽