** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - buscarv múltiples resultados
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradobuscarv múltiples resultados

 Responder Responder
Autor
Mensaje
Elenam_80 Ver desplegable
Habitual
Habitual


Unido: 04/Mayo/2015
Localización: Madrid
Estado: Sin conexión
Puntos: 121
Enlace directo a este mensaje Tema: buscarv múltiples resultados
    Enviado: 23/Marzo/2020 a las 13:08
Hola!
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. El rango que he definido sigue siendo el mismo.

(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.

Gracias!!


Ele
Arriba
Elenam_80 Ver desplegable
Habitual
Habitual


Unido: 04/Mayo/2015
Localización: Madrid
Estado: Sin conexión
Puntos: 121
Enlace directo a este mensaje Enviado: 23/Marzo/2020 a las 14:41
Hola! Me acaban de dar la respuesta y funciona, la dejo aquí por si le sirve de ayuda a alguien ;). Sl2!

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
Ele
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5970
Enlace directo a este mensaje Enviado: 23/Marzo/2020 a las 19:48
Un poco más corto:

Sub Reparte()

  Dim celda As Range, fila&, filau&, col&

  filau = Cells(Rows.Count, 1).End(xlUp).Row

  [CC1] = [B1]

  Range("B1:B" & filau).AdvancedFilter Action:=xlFilterCopy, _

      CopyToRange:=Range("CC1"), Unique:=True

  With Worksheets(2)

    .Range("A1").CurrentRegion.Offset(1).ClearContents

    For Each celda In Range("A2:A" & filau)

      fila = celda.Value + 1

      col = WorksheetFunction.Match(celda.Offset(, 1), Range("CC1:CC100"), 0)

      .Cells(fila, 1).Value = celda.Value

      .Cells(fila, col).Value = celda.Offset(, 1).Value

    Next celda

  End With

  Range("CC1").CurrentRegion.ClearContents

End Sub




Saludos desde Tenerife.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable