关注公众号:万能的Excel 并回复【实时筛选】获取源文件!
功能说明:
当客户群体到达一定数量后,统计信息往往编程一项非常繁琐的工作。根据关键字自动搜索并且列出完整的信息编程一项必不可少的功能
本工作表实现的功能:
1、Excel 根据关键字进行模糊查找
2、不限数据库大小
3、生成下拉菜单
附上代码:
Private Sub ListBox1_Click()
arr = Sheet7.Range("A1").CurrentRegion
t = UBound(arr)
On Error Resume Next
k = Application.WorksheetFunction.Match(Me.ListBox1.Value, Sheet7.Range("A1:A" & t), 0)
ActiveCell.Value = Me.ListBox1.Value
ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.Index(Sheet7.Range("c:c"), k)
Me.TextBox1.Visible = False
End Sub
Private Sub TextBox1_Change() '检测TextBox 中是否有输入
Dim arr, i%, j%, d
Set 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 If
Next
Me.ListBox1.Clear
If d.Count >= 1 Then Me.ListBox1.List = d.keys '输出搜索结果
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
If Target.Column <> 5 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
If Target.Row < 2 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
Dim arr, i%, j%, d
Set d = CreateObject("scripting.dictionary") '获取页面内容
arr = Sheet7.Range("A1").CurrentRegion '创建字典用于保存搜索到的结果
For i = 2 To UBound(arr)
d(arr(i, 1)) = "" '保存符合条件的数据
Next
With Me.TextBox1 '显示TextBox
.Top = Target.Top
.Left = Target.Left
.Width = Target.Width
.Height = Target.Height
.Activate
.Value = ""
.Visible = True
End With
With 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 = True
End With
End Sub