vba模糊查询并显⽰到列表框_如何⽤vba做出类似百度搜索那样的逐步提⽰模糊查询下拉列表框?...
如下图所⽰,
textbox控件边框设置当我们在百度搜索框中搜索关键字时,百度搜索框会⾃动列出含有关键字的搜索历史供下拉选择。
类似地,在excel中,也经常遇到类似的需求。希望在excel单元格中输⼊关键字后列出所有含有该关键字的相关列表供快速选择。
要实现上述功能,需要解决以下⼏个问题:所有的列表项需要集合在数组或者单元格区域中;
在要实现的单元格区域中触发Worksheet_SelectionChange事件;
在Worksheet_SelectionChange事件下可以弹出⽂本框控件⽤于输⼊关键字,每输⼊⼀个关键字,可以⾃动筛选列表项数组在列表框控件中列出筛选的结果数组;
在列表框控件中选择了要输⼊的列表项后,⽂本框控件和列表框控件能够隐藏。
其中⽂本框控件和列表框控件也可以⽤组合框控件代替。
接下来介绍代码的实现过程。
为了实现上述功能,可以先⼿动在要实现的⼯作表中插⼊⼀个⽂本框(默认的名称为TextBox1)和列表框(默认的名称为ListBox1)ActiveX 控件,然后在该⼯作表代码窗⼝中输⼊如下的代码:
'定义⼀个公共的数组变量,⽤于存放所有列表框项⽬Public arrPrivate Sub Worksheet_SelectionChange(ByVal Target As Range) Dim oSP As Shape '所有列表项数组 arr = Array('张飞', '关⽻', '刘备', '赵云', '诸葛亮', '⽔星', '张苞', '关平', '孙权', '孙坚', '孙策') '只选中⼀个单元格时触发 If Target.CountLarge = 1 Then '定义触发的单元格⾏列条件 If Target.Column = 1 And Target.Row > 1 Then '满⾜条件先显⽰⽂本框,隐藏列表框 With Me Set oSP = .Shapes('TextBox1') With oSP .Visible = msoCTrue .Left = Target.Offset(0, 1).Left .Top = Target.Top .Height = Target.Height * 1.5 .Width = Target.Width End With Set oSP = .Shapes('ListBox1')
oSP.Visible = msoFalse End With Else '不满⾜条件就不显⽰⽂本框和列表框 With Me Set oSP = .Shapes('TextBox1') oSP.Visible = msoFalse Set oSP = .Shapes('ListBox1') oSP.Visible = msoFalse End With End If Else '不满⾜条件就不显⽰⽂本框和列表框With Me Set oSP = .Shapes('TextBox1') oSP.Visible = msoFalse Set oSP = .Shapes('ListBox1') oSP.Visible = msoFalse End With End IfEnd SubPrivate Sub TextBox1_Change() '读取筛选后的列表框项⽬数组 Dim sText As String sText = TextBox1.Text arrList = VBA.Filter(arr, sText) With ListBox1 .Clear .List = arrList End With '显⽰列表框 With Me Set oSP =
.Shapes('ListBox1') With oSP .Visible = msoCTrue .Left = TextBox1.Left .Top = TextBox1.Top + TextBox1.Height .Height = TextBox1.Height * 5 .Width = TextBox1.Width End With End WithEnd SubPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) '双击列表框中的列表项将内容填⼊当前活动单元格中,同时隐藏列表框 Dim oRng As Range Set oRng = Excel.ActiveCell oRng.Value = ListBox1.Value ListBox1.Visible = False '清空⽂本框内容 TextBox1.Text = ''End Sub
运⾏代码后的效果如下图所⽰,输⼊“张”字,会⾃动列出含有“张”字的所有列表项。

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。