返回列表 上一主題 發帖

[發問] excel VBA 自動更新篩選問題

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Column = 32 And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         If .Value <> "機台異常" Then
            .Rows(.Count).EntireRow.Hidden = True
         End If
      End If
   End If
End With
End Sub

參考!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 3# jsc0518


2個以下篩選取消項有效
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Qx$, Af&, Sc$, i&
   Af = 32
   Sc = ""
   Qx = ""
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         For i = 2 To ActiveSheet.UsedRange.Rows.Count
            If Rows(i).EntireRow.Hidden = True Then
               If Sc = "" Then
                  Sc = Cells(i, "AF")
               End If
               If Qx = "" And Cells(i, "AF") <> Sc Then
                  Qx = Cells(i, "AF")
               End If
               If InStr(Sc & "," & Qx, Cells(i, "AF")) = 0 Then
                  GoTo 99
               End If
            End If
         Next
         Selection.AutoFilter Field:=Af, Criteria1:="<>" & Sc, Operator:=xlAnd, Criteria2:="<>" & Qx
         ActiveSheet.AutoFilter.ApplyFilter
         
99
      End If
   End If
End With
End Sub

參考!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 6# jsc0518


1.如果可以用! 代表方向對了!
2.Andy學很久了!進步很慢!這是用土方法拼湊出來的
2.1.只是用迴圈判斷篩選後隱藏了什麼項目
2.2.如果篩選後隱藏超過兩項就不適用!
      如果兩項以下就以自訂篩選的方式取代取消勾選的篩選
3.應該有更高明的方法! 請高手前輩們指導!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 6# jsc0518


篩選1~5個項目均適用
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Qx$, Af&, Sh$, S1$, S2$, S3$, S4$, S5$, i&
   Af = 32
   Sh = ""
   S1 = ""
   S2 = ""
   S3 = ""
   S4 = ""
   S5 = ""
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         For i = 2 To ActiveSheet.UsedRange.Rows.Count
            If Rows(i).EntireRow.Hidden = True Then
               If Sh = "" Then
                  Sh = Cells(i, "AF")
                  ElseIf InStr(Sh, Cells(i, "AF")) = 0 Then
                     Sh = Sh & "," & Cells(i, "AF")
               End If
               ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
                  GoTo 999
               ElseIf S1 = "" Then
                  S1 = Cells(i, "AF")
               ElseIf S2 = "" And InStr(S1, Cells(i, "AF")) = 0 Then
                  S2 = Cells(i, "AF")
               ElseIf S3 = "" And InStr(S1 & S2, Cells(i, "AF")) = 0 Then
                  S3 = Cells(i, "AF")
               ElseIf S4 = "" And InStr(S1 & S2 & S3, Cells(i, "AF")) = 0 Then
                  S4 = Cells(i, "AF")
               ElseIf S5 = "" And InStr(S1 & S2 & S3 & S4, Cells(i, "AF")) = 0 Then
                  S5 = Cells(i, "AF")
                  Exit For
            End If
            
999
         Next
         If InStr(Sh, .Value) <> 0 Then
            .Rows(.Count).EntireRow.Hidden = True
            Else
               Selection.AutoFilter Field:=Af, Criteria1:=Array( _
                  S1, S2, S3, S4, S5), Operator:=xlFilterValues
               ActiveSheet.AutoFilter.ApplyFilter
         End If
      End If
   End If
End With
End Sub

參考!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 10# jsc0518


ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
     GoTo 999
如果儲存格Cells(i, "AF")是顯示的且在隱藏的儲存格裡有
就跳到 999繼續執行
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 11# jsc0518


    後面有關係到項目的都要類推EX:
ElseIf S6 = "" And InStr(S1 & S2 & S3 & S4 & S5, Cells(i, "AF")) = 0 Then
   S6 = Cells(i, "AF")
~~~

多試幾次就會了!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 11# jsc0518


    應該可以設計不限制項目數量!
但我不會! 靜待高手指導!
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 16# jsc0518


    '研究了3個帖子拼湊出了 不限項目數量的方法
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Af&, Sh$, i&, Arr(), Brr(), K&, Dic As Object
   Set Dic = CreateObject("scripting.dictionary")
   Af = 32
   If .Column = Af And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         Arr = Range("AF2:AF" & ActiveSheet.UsedRange.Rows.Count)
         ReDim Brr(1 To UBound(Arr), 1 To 1)
         For i = 1 To UBound(Arr)
            If Rows(i).EntireRow.Hidden = True Then
               If Sh = "" Then
                  Sh = Cells(i, "AF")
                  ElseIf InStr(Sh, Cells(i, "AF")) = 0 Then
                     Sh = Sh & "," & Cells(i, "AF")
               End If
               ElseIf InStr(Sh, Cells(i, "AF")) <> 0 Then
                  GoTo 999
               ElseIf Dic.exists(Arr(i, 1)) Then
                  Dic(Arr(i, 1)) = ""
                  K = K + 1
                  Brr(K, 1) = Arr(i, 1)
            End If
            
999
         Next
         If InStr(Sh, .Value) <> 0 Then
            .Rows(.Count).EntireRow.Hidden = True
            ElseIf K > 0 Then
               Selection.AutoFilter Field:=Af, Criteria1:=Brr, Operator:=xlFilterValues
               ActiveSheet.AutoFilter.ApplyFilter
         End If
      End If
   End If
End With
End Sub
'猜測生產流程是 待料>待生產>生產中>結批  特殊狀況 機台異常or暫停 以下經驗供參考
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
   '在AF欄儲存格以滑鼠左鍵快按兩次>>依照流程 改變流程進度
   If .Column = 32 And .Row >= 2 Then
      If .Value = "待料" Then
         .Value = "待生產"
         ElseIf .Value = "待生產" Then
            .Value = "生產中"
         ElseIf .Value = "生產中" Then
            .Value = "結批"
         ElseIf .Value = "結批" Then
            MsgBox "?"
         ElseIf .Value = "機台異常" Then
            .Value = "生產中"
         ElseIf .Value = "暫停" Then
            .Value = "生產中"
      End If
      Cancel = True
   End If
   '在AG欄儲存格以滑鼠左鍵快按兩次>>改變流程特別狀況(機台異常)
   If .Column = 33 And .Row >= 2 Then
      If .Cells(1, 0) = "生產中" Then
         .Cells(1, 0) = "機台異常"
      End If
      Cancel = True
   End If
   '在AF1儲存格以滑鼠左鍵快按兩次>>解除全部欄位篩選
   If .Address = "$AF$1" Then
      If ActiveSheet.FilterMode = True Then
         ActiveSheet.ShowAllData
      End If
      Cancel = True
   End If
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
   '在AF欄儲存格按滑鼠右鍵>>直接幫在AF欄篩選當格的項目
   'EX: 在沒有篩選的情況下 在AF2儲存格按滑鼠右鍵,如果AF2的文字是 "生產中" 就幫在AF欄篩選 "生產中"
   If .Column = 32 And .Row >= 2 And .Count = 1 Then
      If ActiveSheet.FilterMode = True Then
         ActiveSheet.ShowAllData
      End If
      Selection.AutoFilter Field:=32, Criteria1:=.Value, Operator:=xlFilterValues
      Cancel = True
   End If
   '在AG欄儲存格按滑鼠右鍵>>改變流程特別狀況(暫停)
   If .Column = 33 And .Row >= 2 Then
      If .Cells(1, 0) = "生產中" Then
         .Cells(1, 0) = "暫停"
      End If
      Cancel = True
   End If
End With

參考!
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 地上種了菜,就不易長草;心中有善,就不易生惡。
返回列表 上一主題