VBA学习(12):制作动态模糊匹配的下拉菜单

今天就再给大家分享一下，如何使用VBA制作更好用的动态模糊匹配下拉菜单。

完成后的效果演示如下：

如上图所示，点击A列单元格，Excel会自动跳出一个文本输入框和一个列表框。当在文本框中输入数据时，列表框的数据会随之动态更新。

1 丨 制作步骤

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

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

保持目标工作表选中状态不变，按快捷键<Alt+F11>打开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 With
End 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 With
End Sub

技术交流，软件开发，欢迎加微信xwlink1996 

---

作者其他作品：

VBA实战(Excel)(1)：提升运行速度

Ribbon第一节：控件大全

HTML实战(1)：新建一个HTML

VB.net实战(VSTO)：Excel插件的安装与卸载