Estoy intentando filtrar una tabla mediante una macro, con elementos diferentes a ciertos específicos, pero no funciona
Lo que quiero es filtrar la tabla, la columna WBS, de manera que los elementos que sean distintos de "36011/01221","36011/01222","36011/01223","36011/01224","36011/01225", se queden en la tabla, es decir sacar fuera a dichos elementos.
Sub eliminar()
Application.ScreenUpdating = False
Dim wsHojaActual9 As Worksheet
Dim wsHojaNueva9 As Worksheet
Dim RangeDats9 As Range
Dim lRow9 As Long
'We set that the page we are working with is the "Foup_AllData"
Set wsHojaActual9 = Worksheets("Foup_AllData")
'We set that the range, is the range we are using on the page, the complete table
Set RangeDats9 = wsHojaActual9.UsedRange
' We apply this codi to filter the table in the 19 position, with elements that are diferente from a blank cell
RangeDats9.AutoFilter Field:=19, Criteria1:=Array("<>*36011/01221*", "<>*36011/01222*"), Operator:=xlAnd
End Sub
2 Respuestas
Te anexo la macro
Sub Macro2()
'Por Dante Amor
' Filtrar columna B con los elementos que aparezcan mas de 1 vez
Dim arreglo()
Set h = Worksheets("Foup_AllData")
If h.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
u = h.Range("S" & Rows.Count).End(xlUp).Row
For i = 2 To u
wbs = Cells(i, "S").Text
Select Case wbs
Case "36011/01221", "36011/01222", "36011/01223", "36011/01224", "36011/01225"
Case Else
ReDim Preserve arreglo(n)
arreglo(n) = wbs
n = n + 1
End Select
Next
h.Range("A1:S" & u).AutoFilter Field:=19, Criteria1:=Array(arreglo), Operator:=xlFilterValues
End SubLo que hace es poner en un arreglo los wbs que son diferentes a los elementos, después filtra la columna S con el arreglo de los wbs
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
¿Al decir sacar quieres decir eliminar las filas?, ¿Copiarlas a otra página? ¿O en la misma página?, esta macro elimina las filas que contengan cualquiera de los criterios de una lista.
Sub quitar()
Dim funcion As WorksheetFunction
Set funcion = WorksheetFunction
lista = Array("36011/01221", "36011/01222", "36011/01223", "36011/01224", "36011/01225")
Set datos = Range("a1").CurrentRegion
With datos
r = .Rows.Count
col = WorksheetFunction.Match("WBS", .Rows(1), 0)
.Sort key1:=Range(.Columns(col).Address), order1:=xlAscending, Header:=xlYes
For i = 0 To UBound(lista)
nlista = lista(i)
cuenta = funcion.CountIf(.Columns(col), lista(i))
If cuenta = 0 Then GoTo siguiente
fila = funcion.Match(lista(i), .Columns(col), 0)
.Rows(fila).Resize(cuenta).EntireRow.Delete
siguiente:
Next i
End With
Set datos = Nothing
End Sub