vba - 用于设置多个过滤条件的用户表单

Question

我有 6 个用户窗体弹出并要求您选择要排序的变量：

1. 客户端过滤器
2. 成本中心过滤器
3. 实用过滤器
4. TypeOfWorkfilter
5. 分析过滤器
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