Board logo

標題: [發問] 點2下快速篩選 [打印本頁]
作者: vinejason    時間: 2016-4-11 15:43     標題: 點2下快速篩選

各位前輩平安
想要簡化篩選動作
例如:
有張表格有7個欄位
資料有數千筆
可否做到
游標所在位置按2下 , 即按所在儲存格的質 , 自動進行篩選
再按2下自動恢復原狀
謝謝
作者: 准提部林    時間: 2016-4-11 18:09

請上傳檔案!
作者: luhpro    時間: 2016-4-12 22:43

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

此類需求我大都是改由 Worksheet_BeforeRightClick 事件來觸發,
頂多是要留意若最後設定 Cancel = True 則執行完直接結束,
可以避免繼續執行預設的 RightClick 程序.
作者: 准提部林    時間: 2016-4-13 10:05

回復 3# luhpro


Worksheet_BeforeDoubleClick 可雙按觸發,
有問題, 沒有附件, 不想再多花時間去寫猜想的程式, 修修改改很費時!!!
作者: luhpro    時間: 2016-4-16 01:18

本帖最後由 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
複製代碼
[attach]23871[/attach]

另一個下載網址 :
http://www.FunP.Net/592865
作者: 准提部林    時間: 2016-4-16 11:54

回復 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 '若非篩選狀態,啟動篩選模式

  11.      If .Parent.AutoFilter.Filters(.Column).On = True Then '判斷該欄是否執行過篩選
  12.         Selection.AutoFilter Field:=.Column '若是該欄已篩選, 顯示全部
  13.      Else
  14.         Selection.AutoFilter Field:=.Column, Criteria1:=.Value '若該欄未篩選, 執行篩選
  15.      End If
  16. End With
  17. End Sub
複製代碼
參考檔：
[attach]23879[/attach]
作者: vinejason    時間: 2016-4-18 09:46

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

但是 仍有困難
執行階段錯誤 424 ,  此處需要物件
If Intersect(uR, .Item(1)) Is Nothing Then   
實在困惑 !
作者: 准提部林    時間: 2016-4-18 14:42

回復 7# vinejason


上傳檔案看看!!
作者: vinejason    時間: 2016-4-18 18:07

回復 8# 准提部林

請看檔案

[attach]23897[/attach][attach]23897[/attach]
作者: 准提部林    時間: 2016-4-18 19:37

回復 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 的問題吧!
作者: vinejason    時間: 2016-4-19 09:21

回復 10# 准提部林

問題解開就使愚人通達 , 羡慕智慧人的聰明 !
謝謝您



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)