Question

如何建立excel多级下拉菜单

Answer 1

　　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 　　效果图: