Macro o Fórmula para buscar el valor de una celda, y devolver todos los valores asociados
Tengo una base de datos y tengo un formulario de búsqueda donde se ingresa un numero de documento y la idea es que la macro busque en la base de datos y devuelva todos los valores asociados a esa celda, a un nivel más básico es un buscarv, pero necesito que me devuelva no solo el primer valor sino todos los valores.
En resumen necesito un buscarv que me devuelva ciertas las filas de la base de datos del mismo valor las veces que se repita
La primera imagen el modelo de base de datos y la segunda es el resultado que debería obtener
Como ya te han pasado una respuesta con fórmulas, te acerco mi propuesta con macros tal como los has solicitado.
El siguiente código realiza un filtro avanzado con criterio ubicado en celda B2 de hoja Resultado.
Tendrás que ajustar todas las referencias a tu modelo ya que en las imágenes no se observan los encabezados de filas/columnas.
Sub filtraClientes()
'x Elsamatilde
Set hob = Sheets("BASE") 'hoja origen
Set hor = Sheets("RESULTADO") 'hoja destino
hob.Select
'se establece el rango a filtrar
finx = Range("A" & Rows.Count).End(xlUp).Row
'el criterio es el nro de la hoja Resultados
nroFil = hor.[B2]
'se selecciona todo el rango aplicando filtro avanzado con copia en la misma hoja
Range("A1:L" & finx).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"X1"), Unique:=False
'si hay datos filtrados se los pasa a cada columna de hoja Resultados a partir de fila 5
If [X2] = "" Then
MsgBox "No se encontraron registros en hoja Base para este número"
Exit Sub
End If
'se copian los registros en cada col:
Range("Y2:AA" & Range("X" & Rows.Count).End(xlUp).Row).Copy Destination:=hor.[A5] 'en col A:C
Range("AF2:AF" & Range("X" & Rows.Count).End(xlUp).Row).Copy Destination:=hor.[D5] 'en col D
hor.Select
End SubDejo comentarios en el código para que puedas ajustar:
- Nombres de hojas
-Columnas donde se encontrarán los datos a copiar. Observa que copié 3 columnas juntas (Y2:AA...) o puede ser de a 1 (AF2:AF...) según lo que quieras copiar.
Este código se coloca en el Editor de macros (entra con atajo de teclado ALt+F11). Inserta un módulo y allí lo pegas.
Para ejecutarlo tenés varias opciones: desde menú Macros, un botón, un atajo de teclado o cuando ingresas un código en la celda B2 (si te decides por esto último comentame para agregarte algo más de código).
Podés leer más sobre cómo ejecutar macros desde la sección Macros de mi sitio.
Agradezco el código pero no lo pude probar porque me esta generando el siguiente error con tu macro
'... error con tu macro...
Primero aclarar que el código que me muestras no es tal como te lo envié. Lo ajustaste y sin ver la línea del error no puedo hacer nada desde aquí.
Reitero lo comentado anteriormente, que debes ajustar en mi macro:
- Nombres de hojas
-Columnas donde se encontrarán los datos a copiar. Observa que copié 3 columnas juntas (Y2:AA...) o puede ser de a 1 (AF2:AF...) según lo que quieras copiar.
Cuando te aparece un error debes presionar el botón 'Depurar' lo que te llevará al Editor y se marcará de color la línea donde se produce el fallo. Eso te ayudará a detectar dónde está el problema. Si no podes solucionarlo enviame la imagen nuevamente.
2 respuestas más de otros expertos
Este es el resultado de la macro, en este
Sub COPIAR_DATOS()
Dim X As WorksheetFunction
Set X = WorksheetFunction
Set H1 = Worksheets("HOJA1")
Set H2 = Worksheets("HOJA2")
Set datos = H1.Range("A1").CurrentRegion
ID = H2.Range("B1")
MENSAJE = "NO EXISTE ESTE NUMERO DE ID"
With datos
.Sort KEY1:=H1.Range(.Columns(1).Address), ORDER1:=xlAscending, Header:=True
R = .Rows.Count: C = .Columns.Count
Set datos = .Rows(2).Resize(R - 1, C)
CUENTA = X.CountIf(.Columns(1), ID)
VALIDA = CUENTA > 0
If VALIDA Then
FILA = X.Match(ID, .Columns(1), 0)
H2.Range("A6").CurrentRegion.ClearContents
Set destino = H2.Range("A6").Resize(CUENTA, C)
With destino
.Value = datos.Rows(FILA).Resize(CUENTA, C).Value
.Rows(0).Value = datos.Rows(0).Value
.Rows(0).Font.Bold = True
.EntireColumn.AutoFit
End With
Else
MsgBox (MENSAJE), vbCritical, "AVISO EXCEL"
End If
End With
Set datos = Nothing: Set destino = Nothing
End Subbusca todos los 4 o el numero que asignes en la celda b1 y los copia de la hoja 1 a la hoja 2
Y esta es la macro
Queda un poco difícil explicarlo por aquí, porque son varias fórmulas.
Supongo que son dos hojas diferentes. Vamos a llamar HOJA1 a la que introduces el dato que quieres buscar y HOJA2 a la hoja donde están los datos.
En la HOJA2 necesitas una columna auxiliar con esta fórmula en cada fila con datos. Supongamos que empiezas en la fila 3 (*) =SI($A3=Hoja1!$C$2;FILA();"")
En la HOJA1, la 1a. Columna debe ser el número de fila encontrado en la fórmula anterior, con esta fórmula (supongamos que en la hoja1 empiezas en la fila5):
=SI.ERROR(K.ESIMO.MENOR(Hoja2!$J:$J;FILA(Hoja2!$J3)-2);"")
(*) MUY IMPORTANTE. En esta fórmula hay que tener en cuenta el número de la fila de la HOJA2 donde comienza el primer dato (en este caso en la fila 3) porque al número de fila (3) hay que restar el número suficiente para que al final quede siempre 1. Por ejemplo, en la HOJA2 el primer dato está en la fila 3, luego hay que restar 2 para que quede 1 en la primera búsqueda en la hoja1: FILA(Hoja2!$J3)-2) y la fórmula entera queda:
=SI.ERROR(K.ESIMO.MENOR(Hoja2!$J:$J;FILA(Hoja2!$J3)-2);"")
Esos dos datos son fundamentales. Con ellos ya puedes obtener el resto de datos con esta fórmula en la hoja1 (como he dicho, suponiendo que empiezas en la fila 5)
=SI(A5="";"";INDICE(Hoja2!B:B;$A5)) para la columna B.
=SI(A5="";"";INDICE(Hoja2!C:C;$A5)) para la columna C... y así sucesivamente.
Queda así:
Prueba y me dices