Macro Pasar tabla filtrada a Matriz
Necesito pasar una tabla a la que le aplico un filtro a una matriz, pero solo los datos que se quedan en ese filtro visible.
Worksheets("DATOS").ListObjects("Tabla1").Range.AutoFilter Field:=6, Criteria1:= _
">=" & Date, Operator:=xlOr, Criteria2:=""
MATRIZ() = Worksheets("DATOS").ListObjects("Tabla1").Range.Value
De esta manera, no se corresponde lo que pasa a la matriz con lo que se ve en el excel con esos filtros
2 respuestas
De momento no se me ocurre una forma más corta de hacerlo:
Option Explicit
Option Base 1
Sub prueba()
Dim Rango As Range
Dim iÁrea As Integer, iFila As Integer, iColumna As Integer
Dim MATRIZ()
Dim iFilaM As Integer
Set Rango = Worksheets("DATOS").ListObjects("Tabla1").Range.SpecialCells(xlCellTypeVisible)
'calcular las filas que necesitará la matriz
For iÁrea = 2 To Rango.Areas.Count 'Para evitar meter en la matriz la fila de títulos
iFila = iFila + Rango.Areas(iÁrea).Rows.Count
Next iÁrea
'redimensionar la matriz
ReDim MATRIZ(iFila, Rango.Columns.Count)
'llenar la matriz con las celdas filtradas
For iÁrea = 2 To Rango.Areas.Count 'El 2 es para evitar meter en la matriz la fila de títulos (que será el área 1 de Rango)
For iFila = 1 To Rango.Areas(iÁrea).Rows.Count
iFilaM = iFilaM + 1
For iColumna = 1 To Rango.Columns.Count
MATRIZ(iFilaM, iColumna) = Rango.Areas(iÁrea).Cells(iFila, iColumna).Value
Next iColumna
Next iFila
Next iÁrea
Set Rango = Nothing
'
'el código que vaya después
'
End SubSaludos_
Hola,
Gracias por tu respuesta. Pero el resultado que me da es el mismo. Al parecer el 1er filtro funciona bien, cuando se aplica el "Rango" tiene los mismo datos que la tabla visible, per el 2do se mantienen visible muchos mas datos que los que se quedan en "Rango" o que se adicionan a la Matriz. Podrías revisar el tema de filtros que es lo que falla, porque no coinciden?
Worksheets("DATOS").ListObjects("Tabla1").Range.AutoFilter Field:=1, Criteria1:= _
"=Cliente", Operator:=xlOr, Criteria2:="=Grupo precio cliente"
Worksheets("DATOS").ListObjects("Tabla1").Range.AutoFilter Field:=6, Criteria1:= _
">=" & Now(), Operator:=xlOr, Criteria2:=""
Estos son los dos filtros que aplico.
Ese
">=" & Now()
es lo único que me parece sospechoso. Por probar, intenta
">=" & CLng(Date)
Saludos_
Puedes utilizar una hoja temporal:
Sub TEST()
Dim sh As Worksheet
Dim matriz() As Variant
Set sh = Sheets("Temp")
sh.Cells.Clear
With Worksheets("DATOS").ListObjects("Tabla1").Range
.AutoFilter 6, ">=" & Date, xlOr, ""
.Copy sh.Range("A1")
End With
matriz() = sh.Range("A1").CurrentRegion
End SubOtra opción es llenar la matriz con los registros que cumplen la condición:
Sub test2()
Dim tbl As ListObject
Dim i As Long, j As Long, k As Long
Dim a() As Variant, matriz() As Variant
'
Set tbl = Worksheets("DATOS").ListObjects("Tabla1")
'
For i = 1 To tbl.ListRows.Count
If tbl.DataBodyRange(i, 6) >= Date Or tbl.DataBodyRange(i, 6) = "" Then
k = k + 1
For j = 1 To tbl.ListColumns.Count
ReDim Preserve a(1 To tbl.ListColumns.Count, 1 To k)
a(j, k) = tbl.DataBodyRange(i, j)
Next
End If
Next
If k > 0 Then matriz = Application.Transpose(a)
End Sub