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

如下图所示，

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

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

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

1. 所有的列表项需要集合在数组或者单元格区域中；
2. 在要实现的单元格区域中触发Worksheet_SelectionChange事件；
3. 在Worksheet_SelectionChange事件下可以弹出文本框控件用于输入关键字，每输入一个关键字，可以自动筛选列表项数组在列表框控件中列出筛选的结果数组；
4. 在列表框控件中选择了要输入的列表项后，文本框控件和列表框控件能够隐藏。

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

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

为了实现上述功能，可以先手动在要实现的工作表中插入一个文本框（默认的名称为TextBox1）和列表框（默认的名称为ListBox1）ActiveX控件，然后在该工作表代码窗口中输入如下的代码：

'定义一个公共的数组变量，用于存放所有列表框项目
Public arr
Private 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 If
End Sub
Private 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 With
End Sub
Private 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

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