如何使用VBA建立自己的下拉菜单

如何使用VBA建立自己的下拉菜单

用VBA操作数据有效性，给你一段参考代码
这是基于excel的，et的话要把内置常量改成et形式的
Sub 有效性刷新(Target As Range)
Dim t1 As Range, t2 As Range

Set t1 = Range(Target.Validation.Formula1)
If t1(1).Row = t1(2).Row Then
Set t2 = Range(t1(1), t1(1).End(xlToRight))
Else
Set t2 = Range(t1(1), t1(1).End(xlDown))
End If
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & t2.Address
.ShowError = False
End With
Set t1 = Nothing
Set t2 = Nothing
End Sub

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

数据有效性就可以 楼主可以自己录制一段设置数据有效性的宏 然后根据需求修改即可

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息