filtrar múltiples criterios usando Excel VBA

excel-vba excel-2010

Question

Tengo 8 variables en la columna A, 1,2,3,4,5 y A, B, C.

Mi objetivo es filtrar A, B, C y mostrar solo 1-5.

Puedo hacer esto usando el siguiente código:

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

Pero lo que hace el código es que filtra las variables 1 a 5 y las muestra.

No voy a hacer lo contrario, pero obtengo el mismo resultado, filtrando A, B, C y mostrando las variables 1 a 5

Probé este código:

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

Pero no funcionó.

¿Por qué no puedo usar este código?

Da este error:

error de tiempo de ejecución 1004 método de autofiltro de clase de rango fallido

¿Cómo puedo realizar esto?

Answer 1

Aquí una opción que usa una lista escrita en algún rango, completando una matriz que será filtrada. La información se borrará y luego se ordenarán las columnas.

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

Answer 2

Creo (por experimentar, MSDN no es útil aquí) que no hay una forma directa de hacerlo. Establecer Criteria1 en una Array es equivalente a usar las casillas de verificación en el menú desplegable, ya que dice que solo filtrará una lista en función de los elementos que coincidan con uno de los de la matriz.

Curiosamente, si tiene los valores literales "<>A" y "<>B" en la lista y filtra en estos, la macro grabadora aparece con

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

que funciona Pero si también tiene el valor literal "<>C" y filtra los tres (usando casillas de verificación) mientras graba una macro, la grabadora de macros replica con precisión su código que luego falla con un error. Supongo que lo llamaría un error: hay filtros que puedes hacer usando la interfaz de usuario que no puedes hacer con VBA.

De todos modos, volvamos a tu problema. Es posible filtrar valores no iguales a algunos criterios, pero solo hasta dos valores que no funcionan para usted:

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

Hay un par de soluciones posibles dependiendo del problema exacto:

1. Use una "columna auxiliar" con una fórmula en la columna B y luego filtre en eso, por ejemplo, =ISNUMBER(A2) o =NOT(A2="A", A2="B", A2="C") luego filtre en TRUE
2. Si no puede agregar una columna, use el autofiltro con Criteria1:=">-65535" (o un número adecuado inferior al que espera) que filtrará los valores no numéricos, suponiendo que esto sea lo que desea
3. Escriba un sub VBA para ocultar filas (no es exactamente lo mismo que un autofiltro, pero puede ser suficiente según sus necesidades).

Por ejemplo:

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

Answer 3

No he encontrado ninguna solución en Internet, así que he implementado una.

El código del Autofiltro con criterios es entonces

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

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

De hecho, el método ConstructFilterValueArray () (no función) obtiene todos los valores distintos que encontró en una columna específica y elimina todos los valores presentes en el último argumento.

El código VBA de este método es

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

Este código ciertamente se puede mejorar al devolver un Array of String, pero trabajar con Array en VBA no es fácil.

PRECAUCIÓN: este código solo funciona si define una hoja llamada X porque el parámetro CopyToRange utilizado en AdvancedFilter () necesita un rango de Excel.

Es una pena que Microfsoft no haya implementado esta solución al agregar simplemente una nueva enumeración como xlNotFilterValues. ... o xlRegexMatch!

Answer 4

Reemplace Operador: = xlOr con Operador: = xlY entre sus criterios. Vea a continuación el script modificado

myRange.AutoFilter Field: = 1, Criteria1: = "<> A", Operator: = xlAnd, Criteria2: = "<> B", Operator: = xlAnd, Criteria3: = "<> C"

Answer 5

Una opción usando AutoFilter

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

Answer 6

Alternativa usando la función de filtro de VBA

Como una alternativa innovadora a la respuesta reciente de @schlebe, traté de usar la función Filter integrada en VBA , que permite filtrar una cadena de búsqueda dada configurando el tercer argumento como Falso. Todas las cadenas de búsqueda "negativas" (por ejemplo, A, B, C) se definen en una matriz. Leí los criterios en la columna A a una matriz de campo de datos y básicamente ejecuté un filtrado posterior (A - C) para filtrar estos elementos.

Código

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