返回列表 上一主題 發帖

[發問] 點2下快速篩選

[發問] 點2下快速篩選

各位前輩平安
想要簡化篩選動作
例如:
有張表格有7個欄位
資料有數千筆
可否做到
游標所在位置按2下 , 即按所在儲存格的質 , 自動進行篩選
再按2下自動恢復原狀
謝謝
無止盡的努力上進

請上傳檔案!

TOP

回復 1# vinejason
不論是 WorkSheet 還是 Range 都沒有提供 DblClick 事件,
除非你VB功力很強,
否則還是只能使用系統原有的事件函數來處理.

此類需求我大都是改由 Worksheet_BeforeRightClick 事件來觸發,
頂多是要留意若最後設定 Cancel = True 則執行完直接結束,
可以避免繼續執行預設的 RightClick 程序.

TOP

回復 3# luhpro


Worksheet_BeforeDoubleClick 可雙按觸發,
有問題, 沒有附件, 不想再多花時間去寫猜想的程式, 修修改改很費時!!!

TOP

本帖最後由 luhpro 於 2016-4-16 01:25 編輯

回復 4# 准提部林
嗯...
匆忙下當時我只記得翻 DblClick 事件選單沒往上拉...
是我的疏忽,抱歉.

回復 1# vinejason
現在看到 Worksheet 果然是有 BeforeDoubleClick 事件.
那麼要做到樓主的需求就容易了.
  1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  2.   With Target
  3.     If .Parent.FilterMode Then ' 檢查自動篩選狀態
  4.       Selection.AutoFilter ' 是則取消自動篩選狀態
  5.     Else
  6.       Selection.AutoFilter Field:=.Column, Criteria1:=.Value, VisibleDropDown:=False ' Field : 篩選值欄位號碼, Criteria1 : 篩選值, VisibleDropDown : 自動篩選狀態時要不要顯示向下箭頭
  7.     End If
  8.   End With
  9.   Cancel = True ' 之後不要執行使用者按下 Double Click 的處理動作
  10. End Sub
複製代碼
DblClick後自動篩選.zip (9.28 KB)

另一個下載網址 :
http://www.FunP.Net/592865
1

評分人數

TOP

回復 5# luhpro


提供另一方案參考:
目的:可逐欄進行各條件的篩選,達到越篩越少的效果
  1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  2. Dim uR As Range
  3. Set uR = ActiveSheet.UsedRange
  4. With Target
  5.      If Intersect(uR, .Item(1)) Is Nothing Then Exit Sub '非資料區內, 跳出
  6.      
  7.      Cancel = True
  8.      If .Row = 1 Then .Parent.AutoFilterMode = False: Exit Sub '標題列雙按, 解除篩選模式
  9.      If .Parent.AutoFilterMode = False Then uR.AutoFilter '若非篩選狀態,啟動篩選模式

  10.      If .Parent.AutoFilter.Filters(.Column).On = True Then '判斷該欄是否執行過篩選
  11.         Selection.AutoFilter Field:=.Column '若是該欄已篩選, 顯示全部
  12.      Else
  13.         Selection.AutoFilter Field:=.Column, Criteria1:=.Value '若該欄未篩選, 執行篩選
  14.      End If
  15. End With
  16. End Sub
複製代碼
參考檔:
DblClick後自動篩選_v01.rar (9.25 KB)

TOP

luhpro  與 准提部林  平安
在excel的工作表篩選的功能 , 因為您們變得更便捷
謝謝您們

但是 仍有困難
執行階段錯誤 424 ,  此處需要物件
If Intersect(uR, .Item(1)) Is Nothing Then   
實在困惑 !
無止盡的努力上進

TOP

回復 7# vinejason


上傳檔案看看!!

TOP

回復 8# 准提部林

請看檔案

檔案.zip (127.45 KB)
無止盡的努力上進

TOP

回復 9# vinejason

Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
那個 T 的問題吧!

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題