web-dev-qa-db-de.com

filtern Sie mehrere Kriterien mit Excel vba

Ich habe 8 Variablen in Spalte A, 1,2,3,4,5 und A, B, C. 

Mein Ziel ist es, A, B, C herauszufiltern und nur 1-5 anzuzeigen.

Ich kann dies mit folgendem Code tun:

My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), Operator:=xlFilterValues

Der Code filtert jedoch die Variablen 1 bis 5 und zeigt sie an.

Ich werde nicht das Gegenteil tun, aber das gleiche Ergebnis erzielen, indem ich A, B, C herausfiltere und die Variablen 1 bis 5 zeige

Ich habe diesen Code ausprobiert:

My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), Operator:=xlFilterValues

Aber es hat nicht funktioniert.

Warum kann ich diesen Code nicht verwenden?

Es gibt diesen Fehler:

laufzeitfehler 1004 Die automatische Filtermethode der Bereichsklasse ist fehlgeschlagen

Wie kann ich das machen?

11
user4577989

Ich denke (aus dem Experimentieren - MSDN ist hier nicht hilfreich), dass es keinen direkten Weg gibt, dies zu tun. Das Festlegen von Criteria1 auf eine Array entspricht der Verwendung der Kontrollkästchen in der Dropdown-Liste. Wie Sie sagen, wird eine Liste nur nach Elementen gefiltert, die mit einem der Elemente im Array übereinstimmen.

Interessanterweise, wenn Sie die Literalwerte "<>A" und "<>B" in der Liste haben und nach diesen filtern, wird der Makrorecorder angezeigt

Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"

was funktioniert. Wenn Sie dann aber auch den Literalwert "<>C" haben und während der Aufzeichnung eines Makros nach allen drei Filtern (mithilfe von Kontrollkästchen) filtern, repliziert der Makrorecorder genau Ihren Code, der dann mit einem Fehler fehlschlägt. Ich denke, ich würde das als Fehler bezeichnen - es gibt Filter, die Sie mit der Benutzeroberfläche ausführen können, die Sie mit VBA nicht tun können.

Wie auch immer, zurück zu deinem Problem. Es ist möglich, Werte zu filtern, die nicht einigen Kriterien entsprechen, sondern nur bis zu zwei Werten, die für Sie nicht geeignet sind:

Range("$A$1:$A$9").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd

Abhängig vom genauen Problem sind einige Problemumgehungen möglich:

  1. Verwenden Sie eine "Helfer-Säule" mit einer Formel in Spalte B und filtern Sie danach - z. =ISNUMBER(A2) oder =NOT(A2="A", A2="B", A2="C") filtern Sie dann nach TRUE
  2. Wenn Sie keine Spalte hinzufügen können, verwenden Sie Autofilter mit Criteria1:=">-65535" (oder einer geeigneten Zahl, die niedriger als erwartet ist), wodurch nicht numerische Werte herausgefiltert werden - vorausgesetzt, Sie möchten dies
  3. Schreiben Sie ein VBA-Sub, um Zeilen auszublenden (nicht genau dasselbe wie ein Autofilter, kann aber je nach Bedarf ausreichen).

Zum Beispiel:

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

Ich habe im Internet keine Lösung gefunden, also habe ich eine implementiert.

Der Autofilter-Code mit Kriterien lautet dann

iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))

ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
    , Criteria1:=aFilterValueArray _
    , Operator:=xlFilterValues

Tatsächlich ruft die ConstructFilterValueArray () - Methode (nicht die Funktion) alle unterschiedlichen Werte ab, die in einer bestimmten Spalte gefunden wurden, und entfernt alle im letzten Argument vorhandenen Werte.

Der VBA-Code dieser Methode lautet

'************************************************************
'* 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

Dieser Code kann sicherlich verbessert werden, indem ein Array von Strings zurückgegeben wird, aber die Arbeit mit Array in VBA ist nicht einfach.

ACHTUNG: Dieser Code funktioniert nur, wenn Sie ein Blatt mit dem Namen X definieren, da der in AdvancedFilter () verwendete CopyToRange-Parameter einen Excel-Bereich benötigt!

Es ist eine Schande, dass Microfsoft diese Lösung nicht implementiert hat, indem einfach eine neue Aufzählung als xlNotFilterValues ​​hinzugefügt wurde! ... oder xlRegexMatch!

0
schlebe

Eine Option, die AutoFilter verwendet


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

Hier eine Option, die eine Liste verwendet, die in einem bestimmten Bereich geschrieben wurde, und füllt ein Array, das gefiltert werden soll. Die Informationen werden gelöscht und die Spalten sortiert.

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 mit VBA-Filterfunktion

Als innovative Alternative zu der letzten Antwort von @schlebe habe ich versucht, die in VBA integrierte Funktion Filter zu verwenden, die es erlaubt, herauszufiltern eine bestimmte Suchzeichenfolge, die das dritte Argument setzt zu falsch. Alle "negativen" Suchstrings (z. B. A, B, C) sind in einem Array definiert. Ich lese die Kriterien in Spalte A in ein Datenfeldfeld und führe grundsätzlich eine nachfolgende Filterung (A - C) aus, um diese Elemente herauszufiltern. 

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.