【自动筛选】--神器般的存在

huanglicheng

自动筛选：让Excel筛选变得如此的简单。只需Alt+Q,。
快捷键：Alt+Q
功能介绍：
1、快速筛选与选定单元格内容相同的单元格。
2、支持选择多个单元格。
操作方法：
1、选定单元格，按快捷键Alt+Q即可筛选,
2、再次按Alt+Q可以取消筛选
一个用了会上瘾的功能 。TA正在用着。你呢？
自动筛选2.0.zip (677.11 KB, 下载次数: 794)

2014-2-25 17:31 上传

点击文件名下载附件

张雄友

阁下上次好像有分享过，版本更新了？

jiminyanyan

谢谢分享。。。。

lcjy11185

学习了，有点好用

huanglicheng

张雄友 发表于 2014-2-25 19:12
阁下上次好像有分享过，版本更新了？

嗯嗯是的，更新一次版本。只为分享给更多的人 @_@

liucqa

1. 
   
2. Private Sub auto_open()
   
3.    
   
4.     With Application.CommandBars("Formatting").Controls.Add(Type:=msoControlButton, temporary:=True)
   
5.         .Caption = "自动筛选(&Q)"
   
6.         .OnAction = "自动筛选"
   
7.         .FaceId = 497
   
8.         .TooltipText = "自动筛选当前列与当前单元格相同的内容"
   
9.         .Style = msoButtonIconAndCaption
   
10.     End With
    
11.     Application.OnKey "%{q}", "自动筛选"
    
12. End Sub
    
13. Private Sub auto_close()
    
14.     On Error Resume Next
    
15.     Application.CommandBars("Formatting").Controls("自动筛选(&Q)").Delete
    
16. End Sub
    
17. Sub 自动筛选()
    
18.     arr = Range(ActiveSheet.Range("a1"), ActiveSheet.Cells.SpecialCells(xlLastCell))  '把表中数据赋值给数值
    
19.     If IsArray(arr) = False Then MsgBox "当前表格中没有数据，或只有一个数据": Exit Sub
    
20.     If UBound(arr, 1) = 1 Then MsgBox "当前表格中只有一行数据不需要筛选": Exit Sub
    
21.     If ActiveSheet.FilterMode = True Then Call 取消筛选 Else: Call 执行筛选    '根据当前筛选状态执行对应命令'
    
22. End Sub
    
23. Sub 取消筛选()
    
24.     Dim myrng$    '单元格地址
    
25.     myrng = Selection.Address    '获取当前选定的地址
    
26.     Cells.AutoFilter    '取消筛选'
    
27.     Range(myrng).Select    '选择原先的单元格'
    
28.     Application.StatusBar = False    '恢复状态栏的显示'
    
29. End Sub
    
30. Sub 执行筛选()
    
31.     On Error GoTo line
    
32.     Dim ic%, rng As Range, myrng$   '列号,单元格'
    
33.     Dim kg As Boolean
    
34.     Application.ScreenUpdating = False    '关闭屏闭
    
35.     If Application.Version <> "11.0" Then
    
36.         Call 多值筛选
    
37.     Else
    
38.         If Selection.Rows.Count = 1 Then    ''如果选定的单元格的行数等于1
    
39.             If Range("A1") = "" Then Range("a1") = " ": kg = True
    
40.             For Each rng In Selection    '在选定范围中循环'
    
41.                 ic = rng.Column    '获取列号'
    
42.                 myrng = rng.Value
    
43.                 If IsDate(myrng) = True Then myrng = Application.WorksheetFunction.Text(myrng, rng.NumberFormat)                     '单元格值赋给myrng'
    
44.                 Cells.AutoFilter ic, myrng    '在对应列号中筛选等于对应的单元格的值'
    
45.             Next
    
46.             '--------------------------------------------------
    
47.             If kg = True Then Range("a1") = ""
    
48.             ActiveWindow.ScrollRow = 1    '窗口跳转到第1行
    
49.             If ActiveSheet.FilterMode Then
    
50.                 With ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
51.                     Application.StatusBar = "筛选结果为" & .Count / .Columns.Count - 1 & "个记录 【如需更多其他方便功能 请联系QQ379069784】"
    
52.                 End With
    
53.             End If
    
54.         Else
    
55.             MsgBox "2003版的不支持多行数据筛选，只支持单行数据筛选", 48, "SoSo提示您"
    
56.         End If
    
57.     End If
    
58.     Application.ScreenUpdating = True
    
59. line:
    
60. End Sub
    
61. Sub 多值筛选()
    
62.     On Error GoTo line
    
63.     Dim i%, j%, arr, x1$
    
64.     Dim ic%, ir%, q%, xx
    
65.     Dim d As Object, dic As Object
    
66.     Set d = CreateObject("scripting.dictionary")
    
67.     Set dic = CreateObject("scripting.dictionary")
    
68.     '--------------------------------------------------
    
69.     For Each rng In Selection    '在选定范围中循环'
    
70.         With rng
    
71.             ic = .Column    '获取列号'
    
72.             If IsDate(.Value) = True Then
    
73.                 x1 = Application.WorksheetFunction.Text(.Value, rng.NumberFormat)
    
74.             Else
    
75.                 x1 = .Value
    
76.             End If
    
77.             '--------------------------------------------------
    
78.             If x1 = "" Then x1 = "="
    
79.             If dic.exists(ic) = True Then
    
80.                 dic(ic) = dic(ic) & "|" & x1
    
81.             Else
    
82.                 dic(ic) = x1
    
83.             End If
    
84.         End With
    
85.         '--------------------------------------------------
    
86.         Cells.AutoFilter Field:=ic, Criteria1:=Split(dic(ic), "|"), Operator:=xlFilterValues
    
87.     Next
    
88. line:
    
89. End Sub

复制代码

huanglicheng

源码在楼上小伙伴这，有需要的朋友可以参考一下。^_^

jiangdong110

谢谢分享，不错！

一枕小窗浓睡

超级牛人不吝分享，感谢！

huanglicheng

功能 演示