Excel VBA高级编程

您所在的位置:网站首页 vba实现查找功能的代码 Excel VBA高级编程

Excel VBA高级编程

2024-07-15 18:56| 来源: 网络整理| 查看: 265

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

 



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3