如何使用VBA编写一个“或”筛选器?

huangapple go评论66阅读模式
英文:

how to don an "Or" filter with VBA?

问题

I am currently trying to filter several columns of my Excel sheet depending on which parameters have been selected (they are written in Textboxes in a UserForm). I want to apply an "Or" on these parameters: for example, I want to show the line where it's written "2012" but also the line where it's written "Process" even though they both are not in the same line.

I can only apply an "And" filter at the moment, my "Or" is not working. I tried to use the "Operator = xlOr" but it strangely operates like an "and."

Can you help me, please? I'm stuck since 1 week ago, and it's the only parameter missing to finish a project. Thank you!

英文:

I am currently trying to filter several columns of my Excel sheet depending on which parameters have been selected (they are written in Textox in an UserForm). I want to apply an "Or" on these parameters: for example, I want to show the line where it's written "2012" but also the line where it's written "Process" even though they both are not in the same line.
I can only apply an "And" filter at the moment, my "Or" is not working. I tried to use the "Operator = xlOr" but it strangely operates like an "and"

Can you help me, please? I'm stuck since 1 week ago and it's the only parameter missing to finish a project.
Thank you!

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
    

at the moment the filter only apply the first criteria in T2 to my sheet

At the moment the filter only apply the first criteria in T2 to my sheet. When I'm trying to change it it the apply like an "and "

答案1

得分: 1

以下是翻译好的内容:

"Let's use this simple data setup as an example. It is a table (ListObject) named 'RCA' (like in your provided code)."

"为了筛选多个字段,您必须分别为每个字段执行筛选。以下是一些示例代码,展示了如何使用字典来完成此操作(已进行注释以便理解):"

"Sub FilterMultipleFieldsExample()

Dim ws As Worksheet:    Set ws = ThisWorkbook.Worksheets(1)
Dim rData As Range:     Set rData = ws.ListObjects('RCA').Range

'创建筛选字典
Dim hFilters As Object: Set hFilters = CreateObject('Scripting.Dictionary')
Dim vField As Variant   '创建循环变量,用于遍历字典中的键

'填充字典
hFilters(1) = 'Data A'                      '将字段1的筛选设置为FilterValue1
hFilters(2) = Array('Value1', 'Value3')     '将字段2的筛选设置为FilterValue2和FilterValue3的数组(以便显示两个值)

With rData
    .Parent.AutoFilterMode = False  '移除任何现有的筛选
    For Each vField In hFilters.Keys    '循环遍历筛选字典中的每个字段
        .AutoFilter vField, hFilters(vField), xlFilterValues    '应用该字段的筛选
    Next vField
End With

End Sub"

"代码运行后,数据的外观如下,这样您可以看到筛选已经正确应用:"

"您需要根据您自己的代码来调整这里所呈现的内容。"

英文:

Let's use this simple data setup as an example. It is a table (ListObject) named "RCA" (like in your provided code).

如何使用VBA编写一个“或”筛选器?

In order to filter more than one field, you have to perform the filter separately for each field. Here is some example code that shows how to accomplish this using a dictionary (commented for clarity):

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

Here is what the data looks like after the code has been run, so you can see that the filters applied properly.

如何使用VBA编写一个“或”筛选器?

You'll need to adapt what's presented here for use in your own code.

答案2

得分: 0

以下是您提供的内容的翻译:

当条件复杂时... 那么您需要使用一个辅助列和一个“自定义条件”函数。我准备了一个示例:

将公共函数和公共子程序放在一个模块中
在此模块中,读取用户选择的值,存储在变量中,例如:

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

公共函数 customCriteria(r As Range, changesMade as Range) As Boolean
'r 是表中一行的第一个单元格(行的第一列)
'r.Offset(, 1) 是第二列
'r.Offset(, 2) 是第三列
'在工作表中,我命名了一个单元格为“CHANGES”,使用函数 now() 记录表格DATA或用户参数通过更改事件的每次更改。
'这将更新准备用于筛选的条件列。
'此单元格作为 customCriteria 函数的第二个参数传递。
'在我的示例中,条件逻辑是:检查(第1列包含“BB”并且(第2列等于“2”或第3列等于“YES”))
'如果单元格的值是数值或字符串,请谨慎进行正确的类型比较
'在此示例中,r.Offset(, 1).Value & "" 将该值转换为字符串,以便与"3"进行比较
customCriteria = r.Value Like "" & strFilter1 & "" And (r.Offset(, 1).Value & "" = strFilter2 Or r.Offset(, 2).Value = strFilter3)
End Function

公共子程序 No_Filters(ByRef tbl As ListObject)
With tbl
如果 .AutoFilter.FilterMode Then
.AutoFilter.ShowAllData
End If
End With
End Sub

将 commandButton 单击事件放在 SHEET 模块中

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”按钮来按CRITERIA列筛选数据。

英文:

When the criteria are complex... then you need to use an auxiliary column and a "custom criteria" Function. I prepared an example:

Put the Public Function and Public Sub in a Module
In this module have read the values selected by the user, in variables, eg:

   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

Then you filter the data by the Column CRITERIA, clicking the Button "Recherche"

如何使用VBA编写一个“或”筛选器?

huangapple
  • 本文由 发表于 2023年5月11日 16:58:01
  • 转载请务必保留本文链接:https://go.coder-hub.com/76225836.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定