web-dev-qa-db-fra.com

filtrer plusieurs critères en utilisant Excel vba

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?

excelvbaexcel-vbaexcel-2010excel-2007
11
user4577989

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:

  1. Utilisez une "colonne auxiliaire" avec une formule dans la colonne B, puis filtrez dessus - par ex. =ISNUMBER(A2) ou =NOT(A2="A", A2="B", A2="C") puis filtrer sur TRUE
  2. Si vous ne pouvez pas ajouter de colonne, utilisez autofilter avec 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.
  3. Ecrivez un sous-VBA pour masquer les lignes (pas exactement comme un filtre automatique mais cela peut suffire en fonction de vos besoins).

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
17
aucuparia

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!

0
schlebe

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
0
paul bica

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
0
Ogier

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
0
T.M.