Autofilter sur les colonnes Mutliple Excel VBA

J'ai besoin de filterr un tableau de données où 3 colonnes peuvent contenir le résultat que je search:

Donc, si les critères se trouvent dans les colonnes 1, 2 ou 3, la ligne doit être returnnée.

Données http://im69.gulfup.com/gBZHK.png

Donc, dans les exemples de données ci-dessus, disons que je sélectionne les critères comme "Fat"

Je search l'autofilter pour renvoyer les lignes 1 et 2; Si je sélectionne les critères comme "Drôle", j'ai besoin des lignes 2 et 6 et ainsi de suite ….

Voici mon code qui ne fonctionne pas, car apparemment il essaie de find les lignes dans lesquelles toutes les colonnes contiennent les critères, et ce n'est pas ce que je cherche à faire.

With Sheet1 .AutoFilterMode = False With .Range("A1:D6") .AutoFilter .AutoFilter Field:=2, Criteria1:="Fat", Operator:=xlFilterValues .AutoFilter Field:=3, Criteria1:="Fat", Operator:=xlFilterValues .AutoFilter Field:=4, Criteria1:="Fat", Operator:=xlFilterValues End With End With

J'ai également essayé d'utiliser l' Operator:=xlor mais lorsque j'ai exécuté le code, il n'a donné aucun résultat.

En bref: la ligne doit être returnnée par le filter si le critère se trouve dans la colonne B ou C ou D.

L'aide est vraiment appréciée.

Comme suite aux commentaires, il existe deux façons pour vous.

Utilisez une colonne supplémentaire avec la formule:

 Dim copyFrom As Range With Sheet1 .AutoFilterMode = False With .Range("A1:E6") 'apply formula in column E .Columns(.Columns.Count).Formula = "=OR(B1=""Fat"",C1=""Fat"",D1=""Fat"")" .AutoFilter Field:=5, Criteria1:=True On Error Resume Next Set copyFrom = .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 End With End With If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy

Utilisation pour la boucle avec Union:

 Dim copyFrom As Range Dim i As Long With Sheet1 For i = 2 To 6 If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then If copyFrom Is Nothing Then Set copyFrom = .Range("B" & i) Else Set copyFrom = Union(.Range("B" & i), copyFrom) End If End If Next End With If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy

Pour copyr également l'en-tête:

 Dim copyFrom As Range Dim i As Long With Sheet1 Set copyFrom = .Range("B1") For i = 2 To 6 If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then Set copyFrom = Union(.Range("B" & i), copyFrom) End If Next End With copyFrom.EntireRow.Copy

METTRE À JOUR:

 Dim hideRng As Range, copyRng As Range Dim i As Long Dim lastrow As Long With Sheet1 lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row .Cells.EntireRow.Hidden = False For i = 2 To lastrow If Not (.Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat") Then If hideRng Is Nothing Then Set hideRng = .Range("B" & i) Else Set hideRng = Union(.Range("B" & i), hideRng) End If End If Next If Not hideRng Is Nothing Then hideRng.EntireRow.Hidden = True On Error Resume Next Set copyRng = .Range("B1:B" & lastrow).SpecialCells(xlCellTypeVisible) On Error GoTo 0 End With If copyRng Is Nothing Then MsgBox "There is no rows matching criteria - nothing to copy" Exit Sub Else copyRng.EntireRow.Copy End If

entrez la description de l'image ici