Macro para buscar
Hola, mi pregunta es la siguiente, tengo 2 tablas de excel, en la cual aparecen direcciones una de ellas tienen al lado una columna que me interesa que aparezca en la otra, la idea es que busque la dirección en la tabla y cuando la encuentre muestre el comentario que tiene al lado.
Muchas gracias.
Muchas gracias.
1 Respuesta
Respuesta de gualo
1
No necesitas una macro, simplemente ordena la primera columna (la de las direcciones, en forma ascendente, lo puedes hacer colocándote en una dirección y marcando el área total de tu tabla, y picando el botón que tiene A->Z.
Después, en donde quieres que te dé la respuesta le pones =buscarv([celda que tiene el valor de la dirección a buscar],[rango de tu tabla],[número de columnas entre la de direcciones y la de comentarios, incluídas ambas]) ej =buscarv(d1, a1:b100, 2), y listo, en esta celda te devolverá el comentario que tiene ligada tu dirección.
Después, en donde quieres que te dé la respuesta le pones =buscarv([celda que tiene el valor de la dirección a buscar],[rango de tu tabla],[número de columnas entre la de direcciones y la de comentarios, incluídas ambas]) ej =buscarv(d1, a1:b100, 2), y listo, en esta celda te devolverá el comentario que tiene ligada tu dirección.
Eso es lo que tengo hecho, el problema es que trabaja con 40700 registros y cada vez que aplico un filtro, se pone a calcular celdas y tarda bastante, quería algo más practico. También decirte que debe buscar por ejemplo 100 direcciones entre esas 40700. GRACIAS.
Te mando la macro que estoy ejecutando, es una de copie de esta página, pero me falla, porque yo lo que quiero es que me copie cuando encuentre el registro la columna de al lado en la otra página, esta fórmula esta preparada para borrar los datos que coincidan, de ese modo si que funciona. La que yo he puesto solo me copia un valor y en una celda concreta, no se como decirle que copie la columna de al lado del valor coincidente en la otra tabla al lado del valor que es igual. ¿Entiendes lo que digo?
Sub Repetidos()
Application.ScreenUpdating = False
m_mens = "ACTUALIZAR EL LISTADO"
M_TIT = "CONFIRMAR"
goon = MsgBox(m_mens, vbOKCancel, M_TIT)
If goon = vbOK Then
Sheets("hoja2").Select
Range("b1").Select
Posicion = 1
While ActiveCell.Value <> ""
valorcomparacion = ActiveCell.Value
Sheets("hoja1").Select
Range("A1").Select
Salir = "no"
While ActiveCell.Value <> "" And Salir = "no"
If ActiveCell.Value = valorcomparacion Then
Selection.EntireRow.Delete
'ActiveCell.Offset(0, 1).Copy Destination:=Sheets("HOJA2").Range("E1") *** SOLO ME COPIA UN REGISTRO
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Wend
Sheets("hoja2").Select
Posicion = Posicion + 1
Range("b1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("A1").Select
Wend
M_TIT = "PROCESO TERMINADO"
m_mens = "YA ESTA"
MsgBox m_mens, vbInformation, M_TIT
End If
Sub Repetidos()
Application.ScreenUpdating = False
m_mens = "ACTUALIZAR EL LISTADO"
M_TIT = "CONFIRMAR"
goon = MsgBox(m_mens, vbOKCancel, M_TIT)
If goon = vbOK Then
Sheets("hoja2").Select
Range("b1").Select
Posicion = 1
While ActiveCell.Value <> ""
valorcomparacion = ActiveCell.Value
Sheets("hoja1").Select
Range("A1").Select
Salir = "no"
While ActiveCell.Value <> "" And Salir = "no"
If ActiveCell.Value = valorcomparacion Then
Selection.EntireRow.Delete
'ActiveCell.Offset(0, 1).Copy Destination:=Sheets("HOJA2").Range("E1") *** SOLO ME COPIA UN REGISTRO
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Wend
Sheets("hoja2").Select
Posicion = Posicion + 1
Range("b1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("A1").Select
Wend
M_TIT = "PROCESO TERMINADO"
m_mens = "YA ESTA"
MsgBox m_mens, vbInformation, M_TIT
End If
Si tienes tu tabla en la "hoja2" con las direcciones en la columna "A" y los comentarios que quieres traer en la columna "B", y en la "hoja1" tienes las direcciones a buscar en la columna "F" y quieres que pegue el comentario en la columna "G", sólo cambia tu macro así:
Sub Traer()
Application.ScreenUpdating = False
' m_mens = "ACTUALIZAR EL LISTADO"
' M_TIT = "CONFIRMAR"
' goon = MsgBox(m_mens, vbOKCancel, M_TIT)
' If goon = vbOK Then
Sheets("hoja2").Select
Range("A1").Select
Posicion = 1
While ActiveCell.Value <> ""
direccion = ActiveCell.Value
Sheets("hoja1").Select
Range("F1").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = direccion Then
Sheets("hoja2").Select
comentario = ActiveCell.Offset(0, 1).Value
Sheets("hoja1").Select
ActiveCell.Offset(0, 1) = comentario
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Wend
Sheets("hoja2").Select
Posicion = Posicion + 1
Range("A1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("A1").Select
Wend
' M_TIT = "PROCESO TERMINADO"
' m_mens = "YA ESTA"
' MsgBox m_mens, vbInformation, M_TIT
' End If
End Sub
Las lineas con "'" inicial son relativas a los cuadros de mensaje, si no quieres que salgan déjalo así (o borra la línea, que ocupa menos memoria) y si quieres que salgan, sólo borra los "'"
Sub Traer()
Application.ScreenUpdating = False
' m_mens = "ACTUALIZAR EL LISTADO"
' M_TIT = "CONFIRMAR"
' goon = MsgBox(m_mens, vbOKCancel, M_TIT)
' If goon = vbOK Then
Sheets("hoja2").Select
Range("A1").Select
Posicion = 1
While ActiveCell.Value <> ""
direccion = ActiveCell.Value
Sheets("hoja1").Select
Range("F1").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = direccion Then
Sheets("hoja2").Select
comentario = ActiveCell.Offset(0, 1).Value
Sheets("hoja1").Select
ActiveCell.Offset(0, 1) = comentario
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Wend
Sheets("hoja2").Select
Posicion = Posicion + 1
Range("A1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("A1").Select
Wend
' M_TIT = "PROCESO TERMINADO"
' m_mens = "YA ESTA"
' MsgBox m_mens, vbInformation, M_TIT
' End If
End Sub
Las lineas con "'" inicial son relativas a los cuadros de mensaje, si no quieres que salgan déjalo así (o borra la línea, que ocupa menos memoria) y si quieres que salgan, sólo borra los "'"
