Excel VBA高级编程 - 根据关键词实时筛选，自动生成下拉菜单

最新推荐文章于 2024-05-17 13:26:27 发布

Rubicon_Chen

最新推荐文章于 2024-05-17 13:26:27 发布

阅读量6k

点赞数 1

分类专栏： Excel 文章标签： excel 实时搜索 vba

本文链接：https://blog.csdn.net/Rubicon_Chen/article/details/107830104

版权

Excel 专栏收录该内容

25 篇文章 28 订阅

订阅专栏

关注公众号：万能的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