Siguiente celda abajo continua o no continua en un filtro

Por favor

Tengo un detalle, me gustaría hacer una macro que involucre un arreglo dependiendo el número de celdas por cada filtro.

Sub Prueba ()
Dim i,n,j
Sheets("Sheet1").Select
Range"("C1").Select
Range(ActiveCell.Offset(1,0), ActiveCell.Offset(1,0).Select
n = Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Count + 1
ReDim strDato1(n)
     For j = 1 to n
          strDato1(j) = Range("C1").Offset(j,0).Value
     Next j
Sheets("VaciarArreglo").Select
Range("A2").Formula = Join(strDato1)
Erase strDato1
End Sub

El código funciona, pero me pasa a la celda siguiente que no esta visible, ya que en la columna D tengo un filtro ... Y las celdas visibles en C pueden estar continuas o no continuas.

1 Respuesta

Respuesta
1

Podrías explicar con un ejemplo qué tienes en C y qué tienes en la columna D.

Y también cuál es el resultado que esperas en A2.

Por cierto, tu macro tiene un par de errores en la escritura:

Tienes esto:

Range"("C1").Select
Range(ActiveCell.Offset(1,0), ActiveCell.Offset(1,0).Select

Debería ser así:

Range("C1").Select
Range(ActiveCell. Offset(1, 0), ActiveCell.Offset(1, 0)).Select


Otro detalle, cuando declares variables debes especificar el tipo, de lo contrario todas estará quedarán como Variant.

Dim i As Long, n As Long, j As Long

Hola, tienes razón..., gracias por la observación

aquí el código corregido

Sub Prueba()
Dim Tienda As String
Dim i, n, j As Integer
Sheets("VaciarArreglo").Select
Range("B1").Select
j = Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Count - 1
For i = 2 To j
Tienda = Range("B" & i).Value
Sheets("Sheet1").Select
Range("D1").Select
ActiveSheet.Range("$C$1:$D$14").AutoFilter Field:=2, Criteria1:=Tienda
Range("C1").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).Select
n = Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Count
ReDim strDato1(n)
     For j = 1 To n
          strDato1(j) = Range("c1").Offset(j, 0).Value
     Next j
Sheets("VaciarArreglo").Select
Range("A2").Formula = Join(strDato1)
Erase strDato1
Next i
End Sub

Practicamente lo que quiero es que en la pestaña "VaciarArreglo", me de solo los datos que tiene wallmart al momento de filtrar en "Sheet1".

Sheet1

Y me gustaría que me diera así

Pero, una vez filtrada la columna D en "Sheet1", selecciona la siguiente celda, pero no la que esta visible en el filtro.

Originalmente me aparece así

Es decir, siempre toma las celdas hacia abajo continuas y no respeta las que muestra el filtro.

Cualquier cosa estoy al pendiente y gracias por tu apoyo :)

La siguiente macro deposita en tu hoja "VaciarArreglo" todos los arreglos.

No es necesario hacer filtrar la hoja "Sheet1", de hecho, antes de ejecutar la macro quita los filtros.

En el código agregué algunas notas para explicar qué hace cada línea.

Ejecuta la macro con los ejemplos que pusiste en las imágenes.

Sub VaciarArreglo()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim dic As Object
  Dim c As Range
  Dim tienda As String
  '
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("VaciarArreglo")
  'crea un dicionario para almacenar índices
  Set dic = CreateObject("Scripting.Dictionary")
  '
  'Con el siguiente ciclo lee los datos de sheet1
  For Each c In sh1.Range("C2", sh1.Range("C" & Rows.Count).End(3))
    'crea un índice para cada tienda
    'va almacenando las frutas en cada índice
    tienda = sh1.Range("D" & c.Row).Value
    dic(tienda) = dic(tienda) & " " & c.Value
  Next
  '
  'Lee las tiendas de la hoja 'VaciarArreglo
  For Each c In sh2.Range("B2", sh2.Range("B" & Rows.Count).End(3))
    'deposita en la columna A las frutas de la tienda
    sh2.Range("A" & c.Row).Value = Trim(dic(c.Value))
  Next
End Sub

Resultado:

Mil gracias Dante!

Funciona al 100% 

Bendiciones y Saludos!

[No olvides cambiar la valoración de la respuesta...

[Encantado de ayudarte, gra cias por comentar.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas