J'ai 8 variables dans la colonne A, 1,2,3,4,5 et A, B, C.
Mon but est de filtrer A, B, C et d’afficher uniquement 1-5.
Je peux le faire en utilisant le code suivant:
My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), Operator:=xlFilterValues
Mais le code filtre les variables 1 à 5 et les affiche.
Je ne ferai pas l'inverse, mais je donnerai le même résultat en filtrant A, B, C et en montrant les variables 1 à 5
J'ai essayé ce code:
My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), Operator:=xlFilterValues
Mais cela n'a pas fonctionné.
Pourquoi ne puis-je pas utiliser ce code?
Cela donne cette erreur:
erreur d'exécution 1004 La méthode de filtrage automatique de la classe d'intervalle a échoué
Comment puis-je effectuer cela?
Je pense (d'après les expériences - MSDN n'est pas utile ici) qu'il n'y a pas de moyen direct de le faire. Définir Criteria1
sur Array
équivaut à utiliser les cases à cocher dans la liste déroulante - car vous dites que cela ne filtrera qu'une liste en fonction d'éléments correspondant à l'un de ceux du tableau.
Fait intéressant, si vous avez les valeurs littérales "<>A"
et "<>B"
dans la liste et que vous filtrez sur celles-ci, l’enregistreur de macros affiche
Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"
qui fonctionne. Mais si vous avez également la valeur littérale "<>C"
et que vous filtrez pour les trois (en cochant des cases) tout en enregistrant une macro, l'enregistreur de macros réplique précisément votre code qui échoue avec une erreur. J'imagine que j'appellerais cela un bug - il existe des filtres que vous pouvez utiliser à l'aide de l'interface utilisateur et que vous ne pouvez pas utiliser avec VBA.
Quoi qu'il en soit, revenons à votre problème. Il est possible de filtrer des valeurs différentes de certains critères, mais uniquement de deux valeurs qui ne fonctionnent pas pour vous:
Range("$A$1:$A$9").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd
Il existe plusieurs solutions possibles en fonction du problème exact:
=ISNUMBER(A2)
ou =NOT(A2="A", A2="B", A2="C")
puis filtrer sur TRUE
Criteria1:=">-65535"
(ou un nombre approprié inférieur à celui attendu) qui filtrera les valeurs non numériques - en supposant que ce soit ce que vous voulez.Par exemple:
Public Sub hideABCRows(rangeToFilter As Range)
Dim oCurrentCell As Range
On Error GoTo errHandler
Application.ScreenUpdating = False
For Each oCurrentCell In rangeToFilter.Cells
If oCurrentCell.Value = "A" Or oCurrentCell.Value = "B" Or oCurrentCell.Value = "C" Then
oCurrentCell.EntireRow.Hidden = True
End If
Next oCurrentCell
Application.ScreenUpdating = True
Exit Sub
errHandler:
Application.ScreenUpdating = True
End Sub
Je n'ai pas trouvé de solution sur Internet, alors j'en ai mis en place une.
Le code de filtrage automatique avec critères est alors
iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))
ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
, Criteria1:=aFilterValueArray _
, Operator:=xlFilterValues
En fait, la méthode ConstructFilterValueArray () (not function) obtient toutes les valeurs distinctes qu'elle a trouvées dans une colonne spécifique et supprime toutes les valeurs présentes dans le dernier argument.
Le code VBA de cette méthode est
'************************************************************
'* ConstructFilterValueArray()
'************************************************************
Sub ConstructFilterValueArray(a() As Variant, iCol As Integer, aRemoveArray As Variant)
Dim aValue As New Collection
Call GetDistinctColumnValue(aValue, iCol)
Call RemoveValueList(aValue, aRemoveArray)
Call CollectionToArray(a, aValue)
End Sub
'************************************************************
'* GetDistinctColumnValue()
'************************************************************
Sub GetDistinctColumnValue(ByRef aValue As Collection, iCol As Integer)
Dim sValue As String
iEmptyValueCount = 0
iLastRow = ActiveSheet.UsedRange.Rows.Count
Dim oSheet: Set oSheet = Sheets("X")
Sheets("Data")
.range(Cells(1, iCol), Cells(iLastRow, iCol)) _
.AdvancedFilter Action:=xlFilterCopy _
, CopyToRange:=oSheet.range("A1") _
, Unique:=True
iRow = 2
Do While True
sValue = Trim(oSheet.Cells(iRow, 1))
If sValue = "" Then
If iEmptyValueCount > 0 Then
Exit Do
End If
iEmptyValueCount = iEmptyValueCount + 1
End If
aValue.Add sValue
iRow = iRow + 1
Loop
End Sub
'************************************************************
'* RemoveValueList()
'************************************************************
Sub RemoveValueList(ByRef aValue As Collection, aRemoveArray As Variant)
For i = LBound(aRemoveArray) To UBound(aRemoveArray)
sValue = aRemoveArray(i)
iMax = aValue.Count
For j = iMax To 0 Step -1
If aValue(j) = sValue Then
aValue.Remove (j)
Exit For
End If
Next j
Next i
End Sub
'************************************************************
'* CollectionToArray()
'************************************************************
Sub CollectionToArray(a() As Variant, c As Collection)
iSize = c.Count - 1
ReDim a(iSize)
For i = 0 To iSize
a(i) = c.Item(i + 1)
Next
End Sub
Ce code peut certainement être amélioré en renvoyant un tableau de chaînes, mais travailler avec un tableau dans VBA n'est pas chose facile.
ATTENTION: ce code ne fonctionne que si vous définissez une feuille nommée X car le paramètre CopyToRange utilisé dans AdvancedFilter () nécessite une plage Excel!
Dommage que Microfsoft n'ait pas implémenté cette solution en ajoutant simplement une nouvelle énumération, xlNotFilterValues! ... ou xlRegexMatch!
Une option utilisant le filtre automatique
Option Explicit
Public Sub FilterOutMultiple()
Dim ws As Worksheet, filterOut As Variant, toHide As Range
Set ws = ActiveSheet
If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then Exit Sub 'Empty sheet
filterOut = Split("A B C D E F G")
Application.ScreenUpdating = False
With ws.UsedRange.Columns("A")
If ws.FilterMode Then .AutoFilter
.AutoFilter Field:=1, Criteria1:=filterOut, Operator:=xlFilterValues
With .SpecialCells(xlCellTypeVisible)
If .CountLarge > 1 Then Set toHide = .Cells 'Remember unwanted (A, B, and C)
End With
.AutoFilter
If Not toHide Is Nothing Then
toHide.Rows.Hidden = True 'Hide unwanted (A, B, and C)
.Cells(1).Rows.Hidden = False 'Unhide header
End If
End With
Application.ScreenUpdating = True
End Sub
Voici une option utilisant une liste écrite sur une plage, remplissant un tableau qui sera filtré. Les informations seront effacées puis les colonnes triées.
Sub Filter_Out_Values()
'Automation to remove some codes from the list
Dim ws, ws1 As Worksheet
Dim myArray() As Variant
Dim x, lastrow As Long
Dim cell As Range
Set ws = Worksheets("List")
Set ws1 = Worksheets(8)
lastrow = ws.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Go through the list of codes to exclude
For Each cell In ws.Range("A2:A" & lastrow)
If cell.Offset(0, 2).Value = "X" Then 'If the Code is associated with "X"
ReDim Preserve myArray(x) 'Initiate array
myArray(x) = CStr(cell.Value) 'Populate the array with the code
x = x + 1 'Increase array capacity
ReDim Preserve myArray(x) 'Redim array
End If
Next cell
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
ws1.Range("C2:C" & lastrow).AutoFilter field:=3, Criteria1:=myArray, Operator:=xlFilterValues
ws1.Range("A2:Z" & lastrow).SpecialCells(xlCellTypeVisible).ClearContents
ws1.Range("A2:Z" & lastrow).AutoFilter field:=3
'Sort columns
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Sort with 2 criteria
With ws1.Range("A1:Z" & lastrow)
.Resize(lastrow).Sort _
key1:=ws1.Columns("B"), order1:=xlAscending, DataOption1:=xlSortNormal, _
key2:=ws1.Columns("D"), order1:=xlAscending, DataOption1:=xlSortNormal, _
Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With
End Sub
Alternative utilisant la fonction Filtre de VBA
Alternative innovante à la réponse récente de @schlebe, j’ai essayé d’utiliser la fonction Filter
intégrée à VBA, qui permet de filtrer une chaîne de recherche donnée en définissant le troisième argument Faux. Toutes les chaînes de recherche "négatives" (par exemple, A, B, C) sont définies dans un tableau. Je lis les critères de la colonne A dans un tableau de champs de données et exécute simplement un filtrage ultérieur (A - C) pour filtrer ces éléments.
Code
Sub FilterOut()
Dim ws As Worksheet
Dim rng As Range, i As Integer, n As Long, v As Variant
' 1) define strings to be filtered out in array
Dim a() ' declare as array
a = Array("A", "B", "C") ' << filter out values
' 2) define your sheetname and range (e.g. criteria in column A)
Set ws = ThisWorkbook.Worksheets("FilterOut")
n = ws.Range("A" & ws.Rows.Count).End(xlUp).row
Set rng = ws.Range("A2:A" & n)
' 3) hide complete range rows temporarily
rng.EntireRow.Hidden = True
' 4) set range to a variant 2-dim datafield array
v = rng
' 5) code array items by appending row numbers
For i = 1 To UBound(v): v(i, 1) = v(i, 1) & "#" & i + 1: Next i
' 6) transform to 1-dim array and FILTER OUT the first search string, e.g. "A"
v = Filter(Application.Transpose(Application.Index(v, 0, 1)), a(0), False, False)
' 7) filter out each subsequent search string, i.e. "B" and "C"
For i = 1 To UBound(a): v = Filter(v, a(i), False, False): Next i
' 8) get coded row numbers via split function and unhide valid rows
For i = LBound(v) To UBound(v)
ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False
Next i
End Sub