Jump to content

Buscarv solo en celdas visibles


Go to solution Solved by Antoni,

Recommended Posts

  • Solution
Posted (edited)

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

    • Sube tu archivo siempre y pon un ejemplo de donde hay que tomar los datos y donde y como deben reflejarse  
    • Hola nuevamente muchachos. Espero estén bien todos, es mi mayor deseo. Estoy teniendo otro problema por acá con la configuración de un TextBox donde quiero expresar números. Propiamente el número que va a estar reflejado en esos TextBox son la división del Salario Mensual entre los días a trabajar y eso me da un índice o tarifa salarial diaria.  No tengo problemas en las operaciones matemáticas, sino en el formato a expresar en el TextBox.  Este dato lo toma el TextBox de la Hoja, la que tengo configurada (Celda) como Numero. Podrían ayudarme. Gracias de antemano y excelente semana para todos. Saludos Pino
    • Buenas tardes. Tengo el siguiente código en una macro:   Sub Prueba() hora = Hour(Now) If hora <= 18 & Sheets("Hoja1").Range("G7") = 1 Then     MsgBox ("haz esto")      ElseIf hora > 18 & Sheets("Hoja1").Range("G7") = 2 Then     MsgBox ("haz esto otro")      Else     MsgBox ("No se cumple") End If End Sub Sin embargo,  siempre se me ejecuta el Else aunque a priori se cumplan las condiciones del If. Adjunto el excel de prueba. ¿Alguna idea del por qué no entra en el If ni en el ElseIf? Gracias   Prueba.xlsm
  • Recently Browsing

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

Important Information

Privacy Policy