[發問] 點2下快速篩選

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

2^#

發表於 2016-4-11 18:09 | 只看該作者

請上傳檔案!

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

3^#

發表於 2016-4-12 22:43 | 只看該作者

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

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

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

4^#

發表於 2016-4-13 10:05 | 只看該作者

回復 3# luhpro

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

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

5^#

發表於 2016-4-16 01:18 | 只看該作者

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

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

回復 1# vinejason
現在看到 Worksheet 果然是有 BeforeDoubleClick 事件.
那麼要做到樓主的需求就容易了.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Parent.FilterMode Then ' 檢查自動篩選狀態
Selection.AutoFilter ' 是則取消自動篩選狀態
Else
Selection.AutoFilter Field:=.Column, Criteria1:=.Value, VisibleDropDown:=False ' Field : 篩選值欄位號碼, Criteria1 : 篩選值, VisibleDropDown : 自動篩選狀態時要不要顯示向下箭頭
End If
End With
Cancel = True ' 之後不要執行使用者按下 Double Click 的處理動作
End Sub

複製代碼

DblClick後自動篩選.zip (9.28 KB)

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

1 評分人數

准提部林: 簡潔,也達成效果!金錢 + 5

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

6^#

發表於 2016-4-16 11:54 | 只看該作者

回復 5# luhpro

提供另一方案參考:
目的：可逐欄進行各條件的篩選，達到越篩越少的效果

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim uR As Range
Set uR = ActiveSheet.UsedRange
With Target
If Intersect(uR, .Item(1)) Is Nothing Then Exit Sub '非資料區內, 跳出
Cancel = True
If .Row = 1 Then .Parent.AutoFilterMode = False: Exit Sub '標題列雙按, 解除篩選模式
If .Parent.AutoFilterMode = False Then uR.AutoFilter '若非篩選狀態,啟動篩選模式
If .Parent.AutoFilter.Filters(.Column).On = True Then '判斷該欄是否執行過篩選
Selection.AutoFilter Field:=.Column '若是該欄已篩選, 顯示全部
Else
Selection.AutoFilter Field:=.Column, Criteria1:=.Value '若該欄未篩選, 執行篩選
End If
End With
End Sub

複製代碼

參考檔：

DblClick後自動篩選_v01.rar (9.25 KB)

vinejason

中學生 Rank: 2

帖子: 124
主題: 43
精華: 0
積分: 167
點名: 0
作業系統: Windows7
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: 台灣台北
註冊時間: 2011-3-16
最後登錄: 2021-10-7

7^#

發表於 2016-4-18 09:46 | 只看該作者

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

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

無止盡的努力上進

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

8^#

發表於 2016-4-18 14:42 | 只看該作者

回復 7# vinejason

上傳檔案看看!!

vinejason

中學生 Rank: 2

帖子: 124
主題: 43
精華: 0
積分: 167
點名: 0
作業系統: Windows7
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: 台灣台北
註冊時間: 2011-3-16
最後登錄: 2021-10-7

9^#

發表於 2016-4-18 18:07 | 只看該作者

回復 8# 准提部林

請看檔案

檔案.zip (127.45 KB)

無止盡的努力上進

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

10^#

發表於 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 的問題吧!