关注公众号：万能的Excel 并回复【实时筛选】获取源文件！

功能说明：

当客户群体到达一定数量后，统计信息往往编程一项非常繁琐的工作。根据关键字自动搜索并且列出完整的信息编程一项必不可少的功能

本工作表实现的功能：

1、Excel 根据关键字进行模糊查找

2、不限数据库大小

3、生成下拉菜单

附上代码:

Private Sub ListBox1_Click()arr = Sheet7.Range("A1").CurrentRegion t = UBound(arr) On Error Resume Nextk = Application.WorksheetFunction.Match(Me.ListBox1.Value, Sheet7.Range("A1:A" & t), 0) ActiveCell.Value = Me.ListBox1.ValueActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.Index(Sheet7.Range("c:c"), k)Me.TextBox1.Visible = False End SubPrivate Sub TextBox1_Change() '检测TextBox 中是否有输入Dim arr, i%, j%, dSet d = CreateObject("scripting.dictionary") '创建字典用于保存搜索到的结果arr = Sheet7.Range("A1").CurrentRegion '获取页面内容For i = 2 To UBound(arr)If InStr(arr(i, 1), Me.TextBox1.Value) Then '遍历数据源，搜索符合条件的用户名d(arr(i, 1)) = "" '保存符合条件的数据End IfNextMe.ListBox1.Clear If d.Count >= 1 Then Me.ListBox1.List = d.keys '输出搜索结果End SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Count > 1 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit SubIf Target.Column <> 5 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit SubIf Target.Row < 2 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub Dim arr, i%, j%, dSet d = CreateObject("scripting.dictionary")'获取页面内容arr = Sheet7.Range("A1").CurrentRegion '创建字典用于保存搜索到的结果For i = 2 To UBound(arr)d(arr(i, 1)) = "" '保存符合条件的数据NextWith Me.TextBox1 '显示TextBox.Top = Target.Top.Left = Target.Left.Width = Target.Width.Height = Target.Height.Activate.Value = "".Visible = TrueEnd WithWith Me.ListBox1 '显示ListBox.Clear.Top = Target.Offset(1, 1).Top.Left = Target.Offset(0, 1).Left.Height = Target.Offset(0, 1).Height * 8.Width = Target.Offset(0, 1).Width * 4.List = d.keys.Visible = TrueEnd WithEnd Sub