Mostrar filas segun indice

jeladio · el 22 de enero

Hola amigos:

Acudo a uds. solicitando su ayuda, tengo lo siguiente una lista en una hoja llamada "listado" en donde tengo dos columnas la primera con el ID y la segunda con el NOMbre del producto; en otra hoja llamada "Indice" tengo en la celda "A2" un listado de numeros separados por comas (,) con las cuales quiero hacer lo siguiente: Hacer un tercer listado (hoja llamada "lista final") en la cual me muestre solo los productos correspondientes a los numeros contenidos en la celda "A2" de la hoja indice. (adjunto un ejemplo de lo quiero hacer con dicho macro)

Espero haberme dado a entender

saludos

filtrar.xls

obed_cruz · el 22 de enero

Ejecuta este código, realiza la tarea que necesitas y si necesitas adecuarlo creo que te será más fácil ya que no estas desde ceros.

Saludos.

Sub Test()
Dim WksTarget As Worksheet
Dim strSource As String, Arr

Set WksTarget = Worksheets("Lista final")
strSource = Worksheets("indice").Range("A2")

 Arr = Split(strSource, ",")
 WksTarget.Range("A2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
 WksTarget.Range("B2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],listado!C[-2]:C[-1],2,0)"

Set WksTarget = Nothing

End Sub
[/PHP]

filtrar.xls

jeladio · el 23 de enero

Muchas gracias Obed, el macro me funciono muy bien, solo una cosita como le hago si son 20 columnas y no 2 como las del ejemplo, y otra pregunta opcional: es posible separar junto con los numeros separados por comas, rangos ej, 2-5 para que nos muestren 2,3,4,5.?

saludos

jeladio · el 4 de febrero

Estimdo Obed:

Quisiera molestarte con el macro que me proporcionaste la vez pasada, aparentemente todo funcionaba bien pero luego detecte el siguiente problema: que en la columna B tengo datos repetidos y entonces ya no me crea el nuevo listado con los datos correctos sino repetidos y me imagino que eso podría pasar con el resto de las columnas que muchos tienen datos repetidos, (son 21 columnas en total) adjunto un archivo con los datos reales que estoy trabajando, espero me puedas ayudar

Saludos

FILTRAR POR NUMERO.rar

obed_cruz · el 5 de febrero

Pega este código en tu libro, agregue una función para eliminar los duplicados.

Option Explicit

Sub test()
Dim WksTarget As Worksheet
Dim strSource As String, Arr

Set WksTarget = Worksheets("permitidos")
strSource = Worksheets("atributos").Range("A2")

 Arr = Split(Duplicados(strSource, ","), ",")

WksTarget.Range("A2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
WksTarget.Range("B2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-2]:C[-1],2,0)"
WksTarget.Range("C2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-3]:C[-1],2,0)"
WksTarget.Range("D2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-4]:C[-1],2,0)"
WksTarget.Range("E2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-5]:C[-1],2,0)"
WksTarget.Range("F2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-6]:C[-1],2,0)"
WksTarget.Range("G2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-7]:C[-1],2,0)"
WksTarget.Range("H2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-8]:C[-1],2,0)"
WksTarget.Range("I2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-9]:C[-1],2,0)"
WksTarget.Range("J2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-10]:C[-1],2,0)"
WksTarget.Range("K2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-11]:C[-1],2,0)"
WksTarget.Range("L2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-12]:C[-1],2,0)"
WksTarget.Range("M2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-13]:C[-1],2,0)"
WksTarget.Range("N2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-14]:C[-1],2,0)"
WksTarget.Range("O2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-15]:C[-1],2,0)"
WksTarget.Range("P2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-16]:C[-1],2,0)"
WksTarget.Range("Q2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-17]:C[-1],2,0)"
WksTarget.Range("R2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-18]:C[-1],2,0)"
WksTarget.Range("S2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-19]:C[-1],2,0)"
WksTarget.Range("T2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-20]:C[-1],2,0)"
WksTarget.Range("U2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-21]:C[-1],2,0)"
WksTarget.Range("V2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-22]:C[-1],2,0)"
WksTarget.Range("W2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-23]:C[-1],2,0)"
'''''''''''''''''''''''''''''''''''ActiveCell.FormulaR1C1 = "+VLOOKUP(RC[-1],PRODUCTOS!C[-1]:R[146]C[21],2,FALSE)"
Set WksTarget = Nothing

End Sub

Function Duplicados(txt As String, Optional delim As String = " ") As String
Dim i
  With CreateObject("Scripting.Dictionary")
   .CompareMode = vbTextCompare
    For Each i In Split(txt, delim)
     If Trim(i) <> "" And Not .exists(Trim(i)) Then .Add Trim(i), Nothing
    Next
    If .Count > 0 Then Duplicados = Join(.keys, delim)
  End With
End Function[/PHP]

jeladio · el 5 de febrero

Estimado Obed: gracias por tu ayuda, con la funcion que me incluiste, me salvaste de un problema que pude haber tenido y que no lo habia contemplado, el problema que tenía era de otro tipo pero ya lo pude solucionar, asi que aca dejo el codigo completo por si le sirve a alguien.

una vez mas Gracias y doy por solucionado este tema.

Option Explicit
Sub test()
Dim WksTarget As Worksheet
Dim strSource As String, Arr

Sheets("permitidos").Range("a2:W500") = ""
Set WksTarget = Worksheets("permitidos")
strSource = Worksheets("atributos").Range("A2")
 Arr = Split(Duplicados(strSource, ","), ",")
WksTarget.Range("A2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
WksTarget.Range("B2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-1],PRODUCTOS!C[-1]:C[21],2,0)"
WksTarget.Range("C2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-2],PRODUCTOS!C[-2]:C[20],3,0)"
WksTarget.Range("D2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-3],PRODUCTOS!C[-3]:C[19],4,0)"
WksTarget.Range("E2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-4],PRODUCTOS!C[-4]:C[18],5,0)"
WksTarget.Range("F2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-5],PRODUCTOS!C[-5]:C[17],6,0)"
WksTarget.Range("G2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-6],PRODUCTOS!C[-6]:C[16],7,0)"
WksTarget.Range("H2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-7],PRODUCTOS!C[-7]:C[15],8,0)"
WksTarget.Range("I2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-8],PRODUCTOS!C[-8]:C[14],9,0)"
WksTarget.Range("J2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-9],PRODUCTOS!C[-9]:C[13],10,0)"
WksTarget.Range("K2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-10],PRODUCTOS!C[-10]:C[12],11,0)"
WksTarget.Range("L2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-11],PRODUCTOS!C[-11]:C[11],12,0)"
WksTarget.Range("M2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-12],PRODUCTOS!C[-12]:C[10],13,0)"
WksTarget.Range("N2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-13],PRODUCTOS!C[-13]:C[9],14,0)"
WksTarget.Range("O2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-14],PRODUCTOS!C[-14]:C[8],15,0)"
WksTarget.Range("P2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-15],PRODUCTOS!C[-15]:C[7],16,0)"
WksTarget.Range("Q2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-16],PRODUCTOS!C[-16]:C[6],17,0)"
WksTarget.Range("R2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-17],PRODUCTOS!C[-17]:C[5],18,0)"
WksTarget.Range("S2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-18],PRODUCTOS!C[-18]:C[4],19,0)"
WksTarget.Range("T2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-19],PRODUCTOS!C[-19]:C[3],20,0)"
WksTarget.Range("U2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-20],PRODUCTOS!C[-20]:C[2],21,0)"
WksTarget.Range("V2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-21],PRODUCTOS!C[-21]:C[1],22,0)"
WksTarget.Range("W2").Resize(UBound(Arr) + 1).FormulaR1C1 = "=VLOOKUP(RC[-22],PRODUCTOS!C[-22]:C[0],23,0)"
Set WksTarget = Nothing

End Sub
Function Duplicados(txt As String, Optional delim As String = " ") As String
Dim i
  With CreateObject("Scripting.Dictionary")
   .CompareMode = vbTextCompare
    For Each i In Split(txt, delim)
     If Trim(i) <> "" And Not .exists(Trim(i)) Then .Add Trim(i), Nothing
    Next
    If .Count > 0 Then Duplicados = Join(.Keys, delim)
  End With
End Function
[/HTML]