標題: [發問] VBA依條件自動篩選 [打印本頁]

---

作者: msmplay    時間: 2016-12-14 20:06     標題: VBA依條件自動篩選

本帖最後由 msmplay 於 2016-12-14 20:11 編輯

想請教網大高手們~~~~~~~

請問如何使用VBA達到以下自動篩選功能：
1.按下「逾期數TOP 5」按鈕時，CZ欄可自動篩選出逾期數前5名。例如圖一
2.按下「完成率低於90%」按鈕時，DA欄可自動篩選出完成率低於90%以下。例如圖二
3.按下「作業天數TOP 5」按鈕時，DB欄可自動篩選出作業天數前5名。例如圖三

說明：
1. 第223列工作數總計不列入篩選條件範圍內
2. 第1與第3條件，如果同時有2個以上均有第5名的相同數據時，則均需篩選出來
3. 因為數據會不斷更新，所以以上三個條件數據均可能不同，故無法使用目前的固定數據錄製成巨集



[attach]26099[/attach]

---

作者: GBKEE    時間: 2016-12-15 08:27

回復 1# msmplay


   [attach]26101[/attach]
2003 可用圖示 前10 項 錄製你所需的看看

1. Operator     選擇性的 XlAutoFilterOperator 資料類型。
   
2. 
   
3. XlAutoFilterOperator 可以是這些 XlAutoFilterOperator 常數之一。
   
4. xlAnd default
   
5. xlBottom10Items           '後面(項目)
   
6. xlBottom10Percent         '後面(百分比)
   
7. xlOr
   
8. xlTop10Items                '前面(項目)   
   
9. xlTop10Percent             '前面(百分比)
   
10. 可使用 xlAnd 和 xlOr 將 Criteria1 和 Criteria2 建構複合準則。

複製代碼

試試看

1. Sub 篩選測試()
   
2.     With Sheets("工作完成率統計")
   
3.         If .FilterMode Then
   
4.             .ShowAllData
   
5.         Else
   
6.             .Range("$B$3:$DB$222").AutoFilter
   
7.         End If
   
8.         .Range("$B$3:$DB$222").AutoFilter Field:=102, Criteria1:="5", Operator:=xlTop10Items
   
9.         '測試前5項紀錄但會差一項,因  資料的最後是工作數總計列也計算進去了
   
10.         ' 所以 Criteria1:="6" ,才會顯示測試前5項紀錄
    
11.         .ShowAllData
    
12.         .Range("$B$3:$DB$222").AutoFilter Field:=103, Criteria1:="5", Operator:=xlTop10Items
    
13.         .ShowAllData
    
14.         .Range("$B$3:$DB$222").AutoFilter Field:=104, Criteria1:="<90%"
    
15.         ' 工作數總計列也有計算進去但 >90%,會顯示
    
16.        .AutoFilterMode = False
    
17.     End With
    
18. End Sub

複製代碼

---

作者: msmplay    時間: 2016-12-15 12:47

回復 2# GBKEE

G大~~~~感謝熱心幫忙ㄛ！不過小妹試了不行ㄟ，按一下任何一個鍵，都會有在出現篩選的動作，但最後又回復到沒有篩選的樣子！你測試可以成功嗎？

---

作者: GBKEE    時間: 2016-12-16 19:16

回復 3# msmplay

將你3個按鈕的程式放在一起了,你可拆開成你要的3個巨集,

---

作者: msmplay    時間: 2016-12-17 00:37

本帖最後由 msmplay 於 2016-12-17 00:40 編輯

回復 4# GBKEE

   原來如此丫~~~~~真是太感謝您了G大!!不過可以再請教一下~~~~就是小妹自己改好之後如附件，但遇到以下問題
1.逾期數會顯示223列總計，完成率、作業天數是否也可以同樣篩選後固定顯示223列總計呢?
2.作業天數篩選後發現同樣TOP10的數字10共有3個，但因為顯示為TOP10，所以並列為第10大的數字10只顯示了2個，列193反而沒辮法顯示(已反紅)，請問這是否有其他解決方法呢?


非常感謝~~~~~~~
[attach]26114[/attach]

---

作者: GBKEE    時間: 2016-12-17 05:49

回復 5# msmplay
193列時際上是9.5,因你格式上採用數值小數點0位,所以顯示為10
可修改公式=IF(SUM(G193:CX193)=0,"-",ROUND(AVERAGE(G193:CX193),0))

---

作者: 准提部林    時間: 2016-12-17 11:38

假如第1名有2個, 第2名有3個, 前5大, 應是8個???

---

作者: msmplay    時間: 2016-12-17 14:04

回復 7# 准提部林

准大沒錯沒錯！！！

---

作者: msmplay    時間: 2016-12-17 14:06

回復 6# GBKEE

原來如此丫！！謝謝你ㄛG大~~~~~

---

作者: 准提部林    時間: 2016-12-17 19:47

1. Dim FilArea As Range
   
2. 
   
3. Sub 逾期數()
   
4. Dim R&, xClmn As Range, i&, LG, GG, N%
   
5. Call 取消篩選
   
6. Set xClmn = FilArea.Columns(103)
   
7. R = Application.CountIf(xClmn, ">0")
   
8. If R = 0 Then Exit Sub
   
9. Sheets("工作完成率統計").AutoFilterMode = False
   
10. For i = 1 To R
    
11.     LG = Application.Large(xClmn, i)
    
12.     If GG <> LG Then N = N + 1: GG = LG
    
13.     If N = 5 Then Exit For
    
14. Next
    
15. FilArea.AutoFilter Field:=103, Criteria1:=">=" & GG
    
16. End Sub
    
17. 
    
18. Sub 低於90()
    
19. Call 取消篩選
    
20. Sheets("工作完成率統計").AutoFilterMode = False
    
21. FilArea.AutoFilter Field:=104, Criteria1:="<90%"
    
22. End Sub
    
23. 
    
24. Sub 作業天數()
    
25. Dim R&, xClmn As Range, i&, LG, GG, N%
    
26. Call 取消篩選
    
27. Set xClmn = FilArea.Columns(105)
    
28. R = Application.Count(xClmn)
    
29. If R = 0 Then Exit Sub
    
30. Sheets("工作完成率統計").AutoFilterMode = False
    
31. For i = 1 To R
    
32.     LG = Application.Large(xClmn, i)
    
33.     If GG <> LG Then N = N + 1: GG = LG
    
34.     If N = 5 Then Exit For
    
35. Next
    
36. FilArea.AutoFilter Field:=105, Criteria1:=">=" & GG
    
37. End Sub
    
38. 
    
39. Sub 取消篩選()
    
40. Dim R&
    
41. With Sheets("工作完成率統計")
    
42.      .AutoFilterMode = False
    
43.      R = .UsedRange.Rows.Count - 1
    
44.      If R <= 4 Then Exit Sub
    
45.      Set FilArea = .Range("B3:DB" & R)
    
46.      FilArea.AutoFilter
    
47. End With
    
48. End Sub

複製代碼

[attach]26115[/attach]

---

作者: msmplay    時間: 2016-12-17 22:25

回復 10# 准提部林


   謝謝准大~~~~~~~~~~~~~~~~

---

作者: GBKEE    時間: 2016-12-18 08:09

本帖最後由 GBKEE 於 2016-12-18 08:11 編輯

回復 11# msmplay


  [attach]26117[/attach]

1. Option Explicit
   
2. Sub Ex_作業天數()
   
3.     Ex_篩選 "作業天數", 10, 3   'xlTop10Items=3 請看圖示  
   
4. End Sub
   
5. Sub Ex_完成率()
   
6.     Ex_篩選 "完成率", "<0.9", 0
   
7. End Sub
   
8. Sub Ex_逾期數()
   
9.     Ex_篩選 "逾期數", 10, 3
   
10. End Sub
    
11. Sub Ex_篩選(篩選 As String, 篩選準則 As String, xl_Operator As Integer)
    
12.     Dim Rng As Range
    
13.     With Sheets("工作完成率統計")
    
14.         Set Rng = .Rows("1:3").Find(篩選, lookat:=xlWhole)
    
15.         If Rng Is Nothing Then MsgBox "找不到  " & 篩選: Exit Sub
    
16.         Set Rng = Range(Rng.Range("A3"), Rng.Range("A4").End(xlDown).Offset(-1))
    
17.         If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False   ' 取消 [自動篩選]
    
18.         If xl_Operator > 0 Then
    
19.             Rng.AutoFilter Field:=1, Criteria1:=篩選準則, Operator:=xl_Operator ', VisibleDropDown:=False
    
20.         Else
    
21.             Rng.AutoFilter Field:=1, Criteria1:=篩選準則 ', VisibleDropDown:=False
    
22.         End If
    
23.         '**  VisibleDropDown:=False :不在工作表上顯示有 [自動篩選] 下拉箭號
    
24.         Rng(1).Select
    
25.     End With
    
26. End Sub

複製代碼

---

作者: msmplay    時間: 2016-12-18 23:29

回復 12# GBKEE


   謝謝G大熱心幫忙ㄟ~~~~~~~~~~

---

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