Excel buscarv múltiples resultados Visual Basic
Estoy intentando hacer un buscarv en una tabla con múltiples resultados. De normal siempre he sabido hacerlo con uno, he intentado ir creando filtros en la hoja a buscar, pero el buscarv lo del filtro no lo reconoce, busca en toda la hoja igual.
Sería algo así:
Hoja1
Codigo fases
1 A
2 A
1 B
1 C
2 C
3 A
3 B
4 C
Y en la Hoja2 que aparezca así:
CODIGO faseA faseB faseC
1 A B C
2 A C
3 A B C
4 C
En la Hoja2 ya tendría la cabecera creada. Hice una macro con un primer paso para poner en la columna 1 de la Hoja2 los códigos sin duplicados y luego había pensado en ir filtrando en la Hoja1 por cada fase y hacer el buscarv de siempre, pero no funciona.
(las variables ya estarían creadas antes y el rango ya lo habría definido con hoja1)
codigo = Sheets ("Hoja1").Cells (Count, 1)
fase = Application.Vlookup (codigo, rango, 2,False)
¿Alguna idea?
De esta forma solo me pega en la Hoja2 lo primero que encuentra de cada código.
1 respuesta
Te dejo una macro para tu caso. En imagen se observa la Hoja1 y el resultado en Hoja2.
Observa que el texto que se busca en la macro debe coincidir con los títulos en Hoja2 .
Estoy ordenando la Hoja1 sobre si misma. Podrías copiar el rango y pegarlo en otras col auxiliares y ordenarlas allí para no afectar tu tabla original. El código va explicado por lo que no tendrás inconvenientes en ajustarlo, sino consulta nuevamente.
Sub reordenarFases()
'x Elsamatilde
Set ho1 = Sheets("Hoja1")
'controla que haya datos
x = ho1.Range("A" & Rows.Count).End(xlUp).Row
If x < 2 Then MsgBox "No hay datos en Hoja1": Exit Sub
'ordenar la hoja .... opcional: en otro rango o volver a reordenarla al finalizar
If x > 2 Then
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A2:A" & x), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A1:B9" & x)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
'limpiar tabla destino de posibles datos anteriores
Set ho2 = Sheets("Hoja2")
ho2.[A2].CurrentRegion.Offset(1, 0).ClearContents
y = 1 'fila de destino
'recorrer la Hoja1 y crear registro hasta cambiar de código
For i = 2 To x
'si cambia de código se pasa a fila sgte en destino
If ho1.Range("A" & i) <> codi Then
codi = ho1.Range("A" & i)
y = y + 1
ho2.Range("A" & y) = codi
End If
Set busco = ho2.Rows("1:1").Find("Fase" & ho1.Range("B" & i), LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
ho2.Cells(y, busco.Column) = ho1.Range("B" & i)
End If
Next i
MsgBox "Fin del proceso"
End Sub
