Como crear una macro de búsqueda

Necesito crear una macro asociada a un botón que busque el valor no exacto, por ejemplo los números de una matricula de automóvil, en el resto de las hojas del libro y me lleve a la celda en la que se encuentra ese valor. He creado una hoja llamada Buscador en la que insertare un botón asociado a la macro y el resto de hojas tienen nombres de poblaciones, como la cantidad de matriculas que tengo es elevado y no se a que localidad pertenecen pierdo mucho tiempo buscando hoja por hoja. Si hay otra forma más sencilla de hacerlo que no sea una macro, agradeceré me lo indiquen.
Muchas gracias
1

1 respuesta

Respuesta
1
Poes las funciones personalizadas también son macros, pero a mi entender es lo que necesitas, te la dejo y cualquier cosa me comentas:
Function BuscarEnVariosRangos(ValorBuscado As Variant, btColumna As Single, blOrdenado As Boolean, ParamArray mtrR() As Variant) As Variant
Dim iteradorR As Variant, Encontrado As Variant
On Error GoTo NoEncontrado
For Each iteradorR In mtrR()
Encontrado = Application.WorksheetFunction.VLookup(ValorBuscado, iteradorR, btColumna, blOrdenado)
If Not IsEmpty(Encontrado) Then
BuscarEnVariosRangos = Encontrado
Exit Function
End If
Next iteradorR
BuscarEnVariosRangos = "No encontrado."
Exit Function
NoEncontrado:
If Err.Number = 1004 Then
Resume Next
Else
BuscarEnVariosRangos = Err.Description
End If
End Function
La sintaxis de la formula si no la entiendes es la siguiente:
=BuscarEnVariosRangos("Dato Buscado","Número de la columna de la matriz en el que se encuentra el valor que necesitas que retorne",pones 0 similar que en buscav,de aqui en adelante pones las matrices de busqueda.) Y listo
Perdona mi desconocimiento pero por mucho que lo intento no se como indicar la casilla donde esta el dato a buscar (la hoja se llama BÚSQUEDA y el dato se ha de introducir en la celda B14). En las hojas donde se encuentran los datos que quiero que me muestre están en la columna A. Gracias de antemano
Posesionado en la hoja BÚSQUEDA en C14 coolocas la siguiente fórmula:
=BuscarEnVariosRangos(B14,1,Hoja2!A:A,Hoja3!A:A)
Para mi ejemplo mis hojas de búsqueda se llaman Hoja2 y Hoja3, la idea es que las utilices de guía.
Al hacer el cambio me da error de compilación. Se esperaba identificador quedando resaltado el numero 1. Aquí te dejo lo que he puesto, dime por favor donde esta mi error.
Function BuscarEnVariosRangos(B14,1,ATESTADOS!A:A) As Variant, btColumna As Single, blOrdenado As Boolean, ParamArray mtrR() As Variant) As Variant
Lo primero que debes hacer es ir a la hoja de visual basic, abrir un modulo y pegar esta función sin hacerle ningún cambio:
Function BuscarEnVariosRangos(ValorBuscado As Variant, btColumna As Single, blOrdenado As Boolean, ParamArray mtrR() As Variant) As Variant
Dim iteradorR As Variant, Encontrado As Variant
On Error GoTo NoEncontrado
For Each iteradorR In mtrR()
Encontrado = Application.WorksheetFunction.VLookup(ValorBuscado, iteradorR, btColumna, blOrdenado)
If Not IsEmpty(Encontrado) Then
BuscarEnVariosRangos = Encontrado
Exit Function
End If
Next iteradorR
BuscarEnVariosRangos = "No encontrado."
Exit Function
NoEncontrado:
If Err.Number = 1004 Then
Resume Next
Else
BuscarEnVariosRangos = Err.Description
End If
End Function
Luego en la hoja de excel, utilizas la fórmula siguiendo esta sintaxis, como cualquier otra fórmula de excel.
En C14 coolocas la siguiente fórmula:
=BuscarEnVariosRangos(B14,1,Hoja2!A:A,Hoja3!A:A)
Para mi ejemplo mis hojas de búsqueda se llaman Hoja2 y Hoja3, las matrices a buscar son desde la columna A hasta la columna A y el numero de columna de la que necesito la info es la primera.
Me sigue dando error, habría alguna posibilidad de que te enviara un archivo para que veas los problemas que esta dando. He cambiado hasta el nombre de las hojas y he puesto el nombre en las hojas de el mismo nombre que en tu modelo.
Dame tu correo y yo te escribo.
Mi correo es (xxxxxx)
Siento causarte tantas molestias, me comprometí a hacerlo y ahora no se como acabarlo.
Gracias!
La función es igual que un buscarv(), por lo que el resultado de la misma debe estar situado en la misma fila del dato buscado, en tu caso noto que no hay información en la misma fila, y las hojas no tienen uniformidad en el registro de las columnas, recuerda que en esta función solo puedes colocar un indicador de columnas, por lo que la info que deseas traer debe estar ubicada siempre en la misma columna.
Por eso en mi ejemplo puse desde a hasta v, con el indicador 22. Así todo lo que ponga en v me lo traerá dependiendo de la matricula.
Muchas gracias por tu ayuda.
El dato que necesito que busque siempre esta en la columna A.
Hay forma de que cuando ejecute la macro me lleve a la celda donde esta el dato. Por ejemplo, busco la matricula 5506-K pero no se ni en que hoja esta ni en que celda y lo ideal seria que me trasladase a esa celda. (Hoja GRANADA 1:¿21) Es posible?
Gracias de nuevo.
Mercedes
Hay una manera larga y otra corta... La corta es si tienes un listado con los meses por lo que a este macro le adaptas un for para que corra por los 12 meses
On Error Resume Next
Sheets("Abril").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
O la manera larga en la que en el código ya incluye los 12 meses, si te das cuenta son los mismos códigos repetidos 12 veces, la facilidad es que para esta no necesitas el listado.
Sub Busca()
a = Range("A1").Value
On Error Resume Next
Sheets("Enero").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Application.CutCopyMode = False
If Err <> 91 Then
Exit Sub
End If
b = Err
On Error Resume Next
Sheets("Febrero").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Application.CutCopyMode = False
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Marzo").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Abril").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Mayo").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Junio").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Julio").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Agosto").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Septiembre").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Octubre").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Noviembre").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Err <> 91 Then
Exit Sub
End If
On Error Resume Next
Sheets("Diciembre").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
If Err <> 91 Then
Exit Sub
End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas