如何使用 VBA 进行“或”过滤？

Question

我目前正在尝试根据选择的参数过滤我的 Excel 工作表的几列（它们在用户窗体中用 Textox 编写）。我想在这些参数上应用“或”：例如，我想显示写有“2012”的那一行，但也想显示写有“Process”的那一行，即使它们不在同一行。 我现在只能应用“和”过滤器，我的“或”不起作用。我尝试使用“Operator = xlOr”，但奇怪的是它像“and”一样运行

你能帮帮我吗？我从 1 周前就被困住了，这是完成项目唯一缺少的参数。 谢谢！

Private Sub CommandButtonRecherche_Click()

'----------- Création des filtres

    'Déclaration des variables pour les filtres
    Dim strFilter1 As String, strFilter2 As String, strFilter3 As String, strFilter4 As String, strFilter5 As String, strFilter6 As String, strFilter7 As String, strFilter8 As String
    
    'Obtient les valeurs saisies dans les textboxes associés à chaque colonne
    strFilter1 = TextBoxComm.Value
    strFilter2 = TextBoxMach.Value
    strFilter4 = TextBoxClt.Value
    strFilter5 = TextBoxProj.Value
    strFilter6 = TextBoxDT.Value
    strFilter8 = ComboBoxPb.Value
    strFilter3 = TextBoxMotCle1.Value
     
    
    'Définit le champ et le critère de chaque filtre
    Dim field1 As Long, criteria1 As String
    Dim field2 As Long, criteria2 As String
    Dim field3 As Long, criteria3 As String
    Dim field4 As Long, criteria4 As String
    Dim field5 As Long, criteria5 As String
    Dim field6 As Long, criteria6 As String
    Dim field8 As Long, criteria8 As String
    Dim field7 As Long, criteria7 As String
    Dim field9 As Long, criteria9 As String 'toggle button

    Call Clear_Filters

     If strFilter1 <> "" Then 'Numéro de commande
       field1 = 4 'Champ de la colonne associé au premier textbox
       criteria1 = "*" & strFilter1 & "*" 'Critère pour filtrer la colonne associé au premier textbox
       
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field1 'ajout le premier champs au tableau T1
       T2(x) = criteria1 'ajout du premier critère de filtre au tableau T2
       x = x + 1
       
    End If
    

    If strFilter2 <> "" Then 'Machine
        field2 = 3
        criteria2 = "*" & strFilter2 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field2
       T2(x) = criteria2
       x = x + 1
    End If
    

    If strFilter3 <> "" Then 'Mot Clé
       If CheckBoxMot.Value = True Then 'l'utilisateur choisi si il veut appliquer sa recherche sur le champs mot clé ou sur le champ de description complète
           field3 = 8
       Else
           field3 = 5
       End If
       criteria3 = "*" & strFilter3 & "*"

       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field3
       T2(x) = criteria3
       x = x + 1
     End If
       
       
     If strFilter4 <> "" Then 'Client
       field4 = 10
       criteria4 = "*" & strFilter4 & "*"

       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field4
       T2(x) = criteria4
       x = x + 1
     End If

    If strFilter5 <> "" Then 'Projet
        field5 = 11
        criteria5 = "*" & strFilter5 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field5
       T2(x) = criteria5
       x = x + 1
    End If


    If strFilter6 <> "aaaa" Then 'Date
        field6 = 9
        criteria6 = "*" & strFilter6 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field6
       T2(x) = criteria6
       x = x + 1
     End If


    If strFilter8 <> "Sélectionnez le type de problème" Then
        field8 = 7
        criteria8 = "*" & strFilter8 & "*"
 
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field8
       T2(x) = criteria8
       x = x + 1
    End If
    
    
     If OptionButtonOui.Value = True Then
        field9 = 13
        criteria9 = "OUI"
 
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field9 'ajout le premier champs au tableau T1
       T2(x) = criteria9 'ajout du premier critère de filtre au tableau T2
       x = x + 1
    End If

    ' Déclaration des variables pour stocker les valeurs des filtres
    Dim T1Values As String
    Dim T2Values() As String
    Dim i As Long
    
    ' ...
    
    ' Ajouter les valeurs de T1 à la chaîne respective
    For i = LBound(T1) To UBound(T1)
        T1Values = T1Values & T1(i) & vbCrLf
    Next i
    
    ' Déterminer le nombre total de critères dans T2
    Dim totalCriteria As Long
    totalCriteria = UBound(T2) - LBound(T2) + 1
    
    ' Créer un tableau de filtres pour le filtre "OU"
    Dim filterArray() As String
    ReDim filterArray(1 To totalCriteria)
    
    ' Ajouter les critères de T2 au tableau de filtres
    For i = LBound(T2) To UBound(T2)
        filterArray(i - LBound(T2) + 1) = T2(i)
    Next i
    
    ' Appliquer le filtre "OU" avec les critères de T2
    With ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").Range
        .AutoFilter Field:=T1, Criteria1:=filterArray, Operator:=xlFilterValues
    End With
    

目前过滤器仅将 T2 中的第一个条件应用于我的工作表

目前过滤器仅将 T2 中的第一个条件应用于我的工作表。当我试图改变它时，应用就像一个“和”

Answer 1

让我们以这个简单的数据设置为例。它是一个名为“RCA”的表（ListObject）（就像在您提供的代码中一样）。

为了过滤多个字段，您必须对每个字段单独执行过滤。下面是一些示例代码，展示了如何使用字典来完成此操作（为清楚起见已注释）：

Sub FilterMultipleFieldsExample()
    
    Dim ws As Worksheet:    Set ws = ThisWorkbook.Worksheets(1)
    Dim rData As Range:     Set rData = ws.ListObjects("RCA").Range
    
    'Create a filters dictionary
    Dim hFilters As Object: Set hFilters = CreateObject("Scripting.Dictionary")
    Dim vField As Variant   'Create looping variable that will iterate over the keys in the dictionary
    
    'Populate the dictionary
    hFilters(1) = "Data A"                      'Set the filter for field 1 to FilterValue1
    hFilters(2) = Array("Value1", "Value3")     'Set the filter for field 2 to the array of FilterValue2 and FilterValue3 (so that both values will be shown)
    
    With rData
        .Parent.AutoFilterMode = False  'Remove any existing filters
        For Each vField In hFilters.Keys    'Loop through each field in your filters dictionary
            .AutoFilter vField, hFilters(vField), xlFilterValues    'Apply the filter for this field
        Next vField
    End With
    
End Sub

这是代码运行后数据的样子，因此您可以看到过滤器应用正确。

您需要调整此处提供的内容以在您自己的代码中使用。

Answer 2

当条件很复杂时...那么你需要使用辅助列和“自定义条件”功能。我准备了一个例子：

将公共功能和公共子放在一个模块中 在这个模块中读取了用户选择的变量值，例如：

   strFilter1 = TextBox1.value '==> "BB"
   strFilter2 = TextBox2.value '==> "2"
   strFilter3 = TextBox3.value '==> "YES"


Public Function customCriteria(r As Range, changesMade as Range) As Boolean
 'r is the first cell of a line in the table (first column of line)
 'r.Offset(, 1) is the second column
 'r.Offset(, 2) is the third column
 'In the sheet i named a cell "CHANGES", where write the time with the function now() 
'on every change in the table DATA or the user parameters via the change events. 
'This will update the criteria column to be ready for filtering. 
'This cell pass as the second parameter in customCriteria Function.   
'The criteria logic in my example is: Check if (column 1 contains "BB" AND (column 2 equals "2" OR column 3 equals "YES"))
   'Be careful if the value of cell is aritmetic or string to do the right type comparisons
   'in this example the: r.Offset(, 1).value & "" makes the value a string to compare with "3"
   customCriteria = r.value Like "*" & strFilter1 & "*" And (r.Offset(, 1).value & "" = strFilter2 Or r.Offset(, 2).value = strFilter3)
End Function


Public Sub No_Filters(ByRef tbl As ListObject)
   With tbl
      If .AutoFilter.FilterMode Then
         .AutoFilter.ShowAllData
      End If
   End With
End Sub


Put the commandButton click events in the SHEET module

Private Sub CommandButtonRecherche_Click()
   Call No_Filters(Me.ListObjects("RCA"))
   Me.ListObjects("RCA").Range.AutoFilter Field:=4, Criteria1:="TRUE"
End Sub

Private Sub CommandButton_pas_de_filtres_Click()
   Call No_Filters(Me.ListObjects("RCA"))
End Sub

然后按列标准过滤数据，单击按钮“Recherche”