Jump to content

Buscarv solo en celdas visibles


Recommended Posts

Un enfoque sin utilizar filtro.

Sub Buscar()
Application.ScreenUpdating = False
Sheets("Hoja2").Activate
Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
With Hoja1
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("B" & x) = "B" Then
         Set celda = Columns("A").Find(.Range("A" & x), , , xlWhole)
         If Not celda Is Nothing Then
            Range("B" & celda.Row) = .Range("C" & x)
         End If
      End If
   Next
End With
End Sub

 

Edited by Antoni
Link to comment
Share on other sites

Hace 7 minutos , Antoni dijo:

Un enfoque sin utilizar filtro.

Te me adelantastes por la mano... :rolleyes:

@Maria_80,no puedes usar directamente VlookUp directamente sobre un rango filtrado. Otro enfoque con el filtro

Sub buscar_filtrados()
Dim rng, cel As Range, ufo&, ufd&

If Worksheets("Hoja1").FilterMode Then Worksheets("Hoja1").ShowAllData 'Quitamos el filtro
Worksheets("Hoja1").Range("B1").AutoFilter Field:=2, Criteria1:="B", Operator:=xlFilterValues

ufo = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Sheets("Hoja1").Range("A2:A" & ufo).SpecialCells(xlCellTypeVisible)

Sheets("Hoja2").Activate
ufd = Range("A" & Rows.Count).End(xlUp).Row

For Each cel In rng
    For x = 2 To ufd
        If Cells(x, 1) = cel Then
            Cells(x, 2) = cel.Offset(, 2)
            Exit For
        End If
    Next x
Next cel

End Sub

 

Link to comment
Share on other sites

Otra versión mas

Sub BuscarVisibles()

Application.ScreenUpdating = False

Set rango = Hoja2.Range("A2", Hoja2.Range("A1").End(xlDown))
rango.Offset(, 1).ClearContents

For Each c In rango

Set vpb = Hoja1.Range("A:A").Find(c, , , xlWhole)
If Not vpb Is Nothing Then
    f = c.Row: f2 = vpb.Row
    Hoja2.Cells(f, "B") = Hoja1.Cells(f2, "C")
End If

Next

Hoja2.Select
Set vpb = Nothing: Set rango = Nothing

Application.ScreenUpdating = True

End Sub

 

Saludos!

Link to comment
Share on other sites

16 hours ago, Antoni said:

Un enfoque sin utilizar filtro.

Sub Buscar()
Application.ScreenUpdating = False
Sheets("Hoja2").Activate
Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
With Hoja1
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("B" & x) = "B" Then
         Set celda = Columns("A").Find(.Range("A" & x), , , xlWhole)
         If Not celda Is Nothing Then
            Range("B" & celda.Row) = .Range("C" & x)
         End If
      End If
   Next
End With
End Sub

 

Gracias, Antoni! No encontraba nada por ahí. Funcionan todas las soluciones, aunque voy a desarrollar sobre esta, es la que he podido entender mejor para adaptarlo a lo mío y de momento genial. Gracias de nuevo!

Link to comment
Share on other sites

16 hours ago, Gerson Pineda said:

Otra versión mas

Sub BuscarVisibles()

Application.ScreenUpdating = False

Set rango = Hoja2.Range("A2", Hoja2.Range("A1").End(xlDown))
rango.Offset(, 1).ClearContents

For Each c In rango

Set vpb = Hoja1.Range("A:A").Find(c, , , xlWhole)
If Not vpb Is Nothing Then
    f = c.Row: f2 = vpb.Row
    Hoja2.Cells(f, "B") = Hoja1.Cells(f2, "C")
End If

Next

Hoja2.Select
Set vpb = Nothing: Set rango = Nothing

Application.ScreenUpdating = True

End Sub

 

Saludos!

Gracias, funciona del diez!

Link to comment
Share on other sites

16 hours ago, Haplox said:

Te me adelantastes por la mano... :rolleyes:

@Maria_80,no puedes usar directamente VlookUp directamente sobre un rango filtrado. Otro enfoque con el filtro

Sub buscar_filtrados()
Dim rng, cel As Range, ufo&, ufd&

If Worksheets("Hoja1").FilterMode Then Worksheets("Hoja1").ShowAllData 'Quitamos el filtro
Worksheets("Hoja1").Range("B1").AutoFilter Field:=2, Criteria1:="B", Operator:=xlFilterValues

ufo = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Sheets("Hoja1").Range("A2:A" & ufo).SpecialCells(xlCellTypeVisible)

Sheets("Hoja2").Activate
ufd = Range("A" & Rows.Count).End(xlUp).Row

For Each cel In rng
    For x = 2 To ufd
        If Cells(x, 1) = cel Then
            Cells(x, 2) = cel.Offset(, 2)
            Exit For
        End If
    Next x
Next cel

End Sub

 

Muchísimas gracias!

Link to comment
Share on other sites

  • Crear macros Excel

  • Posts

    • Buenos días a todos; -Necesito de vuestra ayuda. Para mejor comprensión adjunto enlace de un video y comentario. Saludos y gracias de antemano     Adjunto también la macro. MEvento.zip
    • No debe importarnos que el usuario que abrió el tema no vuelva a consultarlo porque nuestras respuestas le llegaron demasiado tarde... Lo importante es poder ayudar a otros usuarios que tengan un problema similar en el futuro...
    • Es una opción original e ingeniosa pero creo que difícil de comprender para un usuario que sepa fórmulas sencillas... Adjunto otra opción con fórmulas desbordadas que puede que sea más fácil de comprender para un usuario que esté aprendiendo a formular, pues hay 3 pasos separados: Columna D : A cada valor se le añade 1> a la izquierda, se sustituye el primer + por 2> y el segundo + por 3>. De paso se quitan los signos , y . para convertir los valores en números. Todo ello con la función SUSTITUIR. ="1>"&SUSTITUIR(SUSTITUIR(SUSTITUIR(SUSTITUIR($C2;",";"");".";"");"+";"2>";1);"+";"3>";1)   Columna E (desbordada hacia la derecha en las columnas F y G): Extrae los valores y letras de 1>, 2> y 3>. Todo ello con una versión matricial de la función EXTRAE, con la ayuda de la función ENCONTRAR. =SI.ERROR(SUSTITUIR(EXTRAE($D2;ENCONTRAR({"1>"\"2>"\"3>"};$D2);SI.ERROR(ENCONTRAR({"2>"\"3>"\"0>"};$D2);100)-ENCONTRAR({"1>"\"2>"\"3>"};$D2));{"1>"\"2>"\"3>"};"");"")   Sumas de C, T y V: Suma las cantidades consumidas de cada letra con la función SUMAPRODUCTO. Salu2, Pedro Wave Sumar Letras PW1.xlsx
    • Hola,  Estoy intentando vía InputBox rellenar con el dato introducido una columna. Pero no consigo que lo haga desde la primera fila libre de A. Sería pegar el dato a partir de la primera celda libre de la columna A (está en verde), en función del Nº de filas de la columna B No consigo modificarla y se pega desde el comienzo.  Podéis echarle un vistazo? La macro está en el ejemplo. ¡Muchísimas gracias!      ej_InputBox.xlsm
    • La mía. Sub Mostrar() Application.ScreenUpdating = False Range("B:CM").EntireColumn.Hidden = False End Sub '-- Sub Ocultar() Dim Filtro As Range Application.ScreenUpdating = False Mostrar For y = 2 To Columns("CM").Column If WorksheetFunction.CountIf(Cells(8, y).Resize _ (Range("A" & Rows.Count).End(xlUp).Row, 1), "<>" & Empty) = 0 Then Columns(y).Hidden = True End If Next End Sub  
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy