用戶窗體設置多個篩選條件

Question

我有6個用戶窗體其彈出，並請您選擇您要排序的變量：

1. ClientFilter
2. CostCenterFilter
3. UtilityFilter
4. TypeOfWorkfilter
5. AnalystFilter
6. ProjMgrFilter

在每個變量中使用if語句。

Sub UpdateCF() 
    Integer_CF = -1 

    If AU_CF.Value = True Then 
     Add_CF String_CF, "AU" 
     Range("$B$6:$AU$68").AutoFilter _ 
       Field:=2, Criteria1:=String_CF, _ 
       Operator:=xlFilterValues 
    End If 

    If AULaw_CF.Value = True Then 
     Add_CF String_CF, "AULAW" 
     Range("$B$6:$AU$68").AutoFilter _ 
       Field:=2, Criteria1:=String_CF, _ 
       Operator:=xlFilterValues 
    End If 
    ... 

End Sub 

Sub Add_CF(String_CF() As String, NewValue As String) 
    Integer_CF = Integer_CF + 1 
    ReDim Preserve String_CF(Integer_CF) 
    String_CF(Integer_CF) = NewValue 
End Sub 

這工作正常，除了我想能夠排序在多個領域。例如，我希望使用客戶端篩選器，然後選擇一個變量，然後使用成本中心用戶窗體同時啓用這兩種排序。

Answer 1

我不知道爲什麼你認爲你有問題 - 你可以使用與上面相同的方法，但將過濾器添加到不同的字段。這將過濾兩個。

例如（顯然，你需要適應您的情況）：

Sub blah() 

    Dim currentFilters_FirstField 
    Dim currentFilters_SecondField 
    Dim field1_Option1, field1_Option2, field2_Option1, field2_Option2 'just an example 
    Dim rng As Range 

    field1_Option1 = True 
    field1_Option2 = True 
    field2_Option1 = True 
    field2_Option2 = False 

    'prepare your filters from the menu etc 
    If field1_Option1 Then appendFilterValue currentFilters_FirstField, "AU" 
    If field1_Option2 Then appendFilterValue currentFilters_FirstField, "AULAW" 
    If field2_Option1 Then appendFilterValue currentFilters_SecondField, "Whatever1" 
    If field2_Option2 Then appendFilterValue currentFilters_SecondField, "Whatever2" 

    Set rng = Range("A1:D100") ' range for the filtering etc 
    rng.AutoFilter 1, currentFilters_FirstField, xlFilterValues 
    rng.AutoFilter 2, currentFilters_SecondField, xlFilterValues 'note the different field this is applying to 

End Sub 

Sub appendFilterValue(ByRef currentFilters, newFilter) 

    If IsArray(currentFilters) Then 
     ReDim Preserve currentFilters(0 To UBound(currentFilters) + 1) 
    Else 
     ReDim currentFilters(0 To 0) 
    End If 

    currentFilters(UBound(currentFilters)) = newFilter 

End Sub