Excel如何制作动态模糊匹配的下拉菜单?

网友投稿 484 2022-10-07

Excel如何制作动态模糊匹配的下拉菜单?

我们知道,可以利用函数制作模糊匹配的下拉菜单,但函数那家伙的特点是小巧灵,数据量稍大,效率就直接弥留之际了。众所周知,在Excel里,高效率解决复杂问题,还是得靠又傻又愣的VBA。那么,今天就再给大家分享一下,如何使用VBA制作更好用的动态模糊匹配下拉菜单。

完成后的效果演示如下:

1 丨 制作步骤

选中目标工作表,在【开发工具】→【插入】→【ActiveX控件】,先后插入一个文本框和一个列表框。控件的大小和存放的位置都随意,反正这事你说了也不算,后面代码会自己做调整。

Excel如何制作动态模糊匹配的下拉菜单?

需要注意的是,如果你不会调整VBA代码,那么此处文本框的名字必须为TextBox1,列表框的名字必须为ListBox1——正常而言,这俩名字也都是系统默认的。

保持目标工作表选中状态不变,按快捷键打开VBE编辑器,将以下代码粘贴到当前工作表的代码窗口。

代码解析见注释

'设置文本框和列表框的大小及位置Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim b As Boolean, arr If Target.Column <> 1 Or Target.Row < 2 Then b = True '如果用户选择的单元格不是第1列或者属于第1行 If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then b = True '如果用户选择的单元格数量大于1 If b Then ListBox1.Visible = False '不可见 TextBox1.Visible = False '不可见 Exit Sub '退出程序 End If With Worksheets("示例") '下拉列表来源内容的所在工作表 arr = .Range("d2:d" & .Cells(Rows.Count, "d").End(3).Row) '数据源 End With With TextBox1 .Value = "" .Visible = True '可见 .Top = Target.Top '文本框顶部位置 .Left = Target.Left '文本框左侧位置 .Height = Target.Height '文本框高度 .Width = Target.Width '文本框宽度 .Activate '激活文本框 End With With ListBox1 .Visible = True '可 .Top = Target.Offset(0, 1).Top .Left = Target.Offset(0, 1).Left .Height = Target.Height * 5 .Width = Target.Width .List = arr '写入数据源数据 End WithEnd Sub'根据文本框的输入值动态匹配数据Private Sub TextBox1_Change() Dim arr, brr, i&, k& With Worksheets("示例") '下拉列表来源内容的所在工作表 arr = .Range("d2:d" & .Cells(Rows.Count, "d").End(3).Row) '数据源 End With If TextBox1.Text = "" Then ListBox1.List = arr: Exit Sub ReDim brr(1 To UBound(arr)) For i = 1 To UBound(arr) If InStr(1, arr(i, 1), TextBox1.Text, vbTextCompare) Then '忽略字母大小写 k = k + 1 brr(k) = arr(i, 1) End If Next ListBox1.List = brr '写入匹配后的数据End Sub'如果双击列表框的内容则写入活动单元格Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ActiveCell = ListBox1.Text With ListBox1 .Clear '清空列表框 .Visible = False End With With TextBox1 .Value = "" .Visible = False End WithEnd Sub

最后关闭VBE,将当前工作簿另存为xlsm文件即可。

……

2 丨 其它

如果你不懂VBA,按以上步骤操作后,需要将代码中的”示例”替换为下拉列表数据源所在的工作表名,将”d2:d” & .Cells(Rows.Count, “d”)部分,替换为实际数据源所在列。

With Worksheets("示例") '下拉列表来源内容的所在工作表arr = .Range("d2:d" & .Cells(Rows.Count, "d").End(3).Row) '数据源End With

来源:https://mp.weixin.qq.com/s/oWpO2KTfpDwYtHuEYsYP4Q

版权声明:本文内容由网络用户投稿,版权归原作者所有,本站不拥有其著作权,亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容,请联系我们jiasou666@gmail.com 处理,核实后本网站将在24小时内删除侵权内容。

上一篇:连代码调试都一窍不通,还谈啥会VBA?
下一篇:提取不重复名单,简单方法请拿好
相关文章