如何用vba做出类似百度搜索那样的逐步提示模糊查询下拉列表框？

如下图所示，

当我们在百度搜索框中搜索关键字时，百度搜索框会自动列出含有关键字的搜索历史供下拉选择。

类似地，在excel中，也经常遇到类似的需求。希望在excel单元格中输入关键字后列出所有含有该关键字的相关列表供快速选择。

要实现上述功能，需要解决以下几个问题：

1. 所有的列表项需要集合在数组或者单元格区域中；

2. 在要实现的单元格区域中触发Worksheet_SelectionChange事件；

3. 在Worksheet_SelectionChange事件下可以弹出文本框控件用于输入关键字，每输入一个关键字，可以自动筛选列表项数组在列表框控件中列出筛选的结果数组；

4. 在列表框控件中选择了要输入的列表项后，文本框控件和列表框控件能够隐藏。

其中文本框控件和列表框控件也可以用组合框控件代替。

接下来介绍代码的实现过程。

为了实现上述功能，可以先手动在要实现的工作表中插入一个文本框（默认的名称为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

运行代码后的效果如下图所示，输入“张”字，会自动列出含有“张”字的所有列表项。