Jump to content
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Mostrar filas segun indice

jeladio

By jeladio
in Macros y programación VBA

Recommended Posts

jeladio Newbie

jeladio

Posted
Posted

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 Newbie

obed_cruz

Posted
Posted

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 Newbie

jeladio

Posted
  • Author
Posted

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

  • 2 weeks later...
jeladio Newbie

jeladio

Posted
  • Author
Posted

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 Newbie

obed_cruz

Posted
Posted

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 Newbie

jeladio

Posted
  • Author
Posted

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]

Archived

This topic is now archived and is closed to further replies.

Go to topic listing

  • 108 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Files

  • Download Statistics

    • Files
      184
    • Comments
      96
    • Reviews
      28
    More information about "Un juego solitario en Excel"
    Latest File
    Un juego solitario en Excel
    By pegones1

    4    0

  • Crear macros Excel

  • Posts

    • MarianoCruz
      Macro copiar rango variable per copn celdas combinadas

      By MarianoCruz · Posted

      Hola buenas tardes tengo un archivo en excel que copia varias tablas y las importa a word de manera automatica. Este selecciona las tablas en base a las filas con datos de mi columna C. pueden ser  diferentes rango de tablas. (Pero siempre mi rango es de celdas continuas y con valores continuas) Funciona muy bien. El problema que ahora tengo es que muchos archivos con tablas  tienen las celdas combinadas ya sea horizontalmento o vertical. Aqui es donde empieza mi problema ya que son formatos de origen no puedo modificarlas. Quisiera ajustar mi macro en la parte de seleccion de rango de tablas y que pueda considerar la celdas combinadas y pegarlos en word sin problema. Ya que actualmente no me pone algunas tablas o rangos, o me repite las tablas y no considera las demas. Todo esto a que en algunas no hay valores o las celdas estan combinadas.   Muchas gracias Seleccion automatica de celdas combis.xlsx
    • Héctor Miguel
      FUNCIÓN "UNICOS" EN EXCEL 365

      By Héctor Miguel · Posted

      por si te sirve: la primera matriz (pivotarpor) al inicio los que no tienen profesor asignado (orden ascendente por omision) la segunda (2 matrices y solo unicos) en el orden de aparicion (no asignados al final) la tercera (2 matrices) omite los no asignados (tambien por orden de aparicion) unicos y suma (ayudaExcel).xlsx
    • muyayito
      Exportar a XML. Datos no normalizados

      By muyayito · Posted

      No se si este tema va aquí, si no es así, pido disculpas. Llevo varios días dando vueltas a un fallo que me sale al exportar una tabla a xml y que no consigo resolver. El fallo que me da es que no las asignaciones no son exportables y al comprobar la asignación me dice datos no normalizados.     Libro1.xlsx
    • crengifo
      Comparar los dos últimos datos de una columna dinámica

      By crengifo · Posted

      Buenas tardes estimado JSDJSD, muchas gracias por responder. En efecto esta parte quedo perfecta. Pero me falto indicar que la macro se ejecute dependiendo de la celda L1 ( Caliza o Mezcla). Entonces si dice Caliza aplica la macro que me enviaste, pero si dice Mezcla que haga lo siguiente: Busque el  ultimo dato de la columna K de la hoja Mezcla Adición del libro Base de datos Cementos producido 2024, con la condición de que la columna B debe ser igual a 4 y el dato lo coloque en la celda N1 de la hoja Cemento del libro Cemento. Te comento que el libro Prehomo y Base de datos Cementos producidos 2024 están en carpetas diferentes ya que estos los maneja otra área, como se enmendaría este caso por el comentarios que me enviaste de la ruta. Saludos y un fuerte abrazo   Cemento-2.xlsm
    • JSDJSD
      Comparar los dos últimos datos de una columna dinámica

      By JSDJSD · Posted

      El archivo Cemento.xlsm

  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy

  I accept