Buscar fragmento de texto en una lista
La función INSTR nos permite buscar un fragmento de texto en una lista de cadenas de texto. Nos devuelve la posición dentro de la cadena. Esta cifra es clave: 0 = no coincide, >0 = sí que coincide.
En este ejemplo buscaremos en una lista de apellidos. En el ejemplo abajo, “Aban” nos devuelve dos apellidos. Otro ejemplo sería ‘queiro”, c ual nos devolvería Abanquiero.
Preparamos la hoja
- En celdas C5:C12 tenemos la lista en que buscar (celdas D5:D12 también pertenecen a la matriz.
- En celda G2 introducimos el criterio.
- En celdas G5:H5 el programa pondrá la lista “filtrada”, allí no tienes que introducir nada.
Crear el módulo
Entra a Herramientas – Macros – Editor VBA. A la izquierda ves (si no lo ves CTRL+R) algo como “ProyectoVBA (Tu libro). Marca ese proyecto. Insertar – Módulo.
Doble click en el módulo nuevo, y a la derecha sale un espacio blanco, es para el código.
Ejecutar macro
Para ejecutar esta macro entras a Herramientas – Macros. Allí encontrarás la macro “Buscar_Texto_En_Lista()”. Marca esta, y “Ejecutar“.
Código
Sub Buscar_Texto_En_Lista() 'dimensiones Dim lngUltimaFila As Long Dim strObjetoBuscar As String Dim lngResultado As Long Dim lngColumna As Long, lngFila As Long Dim lngPegarColumna As Long, lngPegarFila As Long Dim x As Integer, n As Integer 'quitar resultados anteriores Range("G5:H4000").ClearContents 'columna + fila donde empezar/terminar búsqueda lngColumna = 2 lngFila = 5 lngUltimaFila = Columns(lngColumna).Range("A65536").End(xlUp).Row 'columna + fila donde empezar a pegar resultados lngPegarColumna = 6 lngPegarFila = 5 'objeto a buscar strObjetoBuscar = Range("G2").Text If strObjetoBuscar = "" Then GoTo 99 'minúsculas strObjetoBuscar = LCase(strObjetoBuscar) 'bucle: realizar búsqueda For n = lngFila To lngUltimaFila 'evaluación lngResultado = InStr(1, Cells(n, 3),strObjetoBuscar, vbTextCompare) 'copiar/pegar If lngResultado > 0 Then Range(Cells(n, 2), Cells(n, 4)).Copy Range( _ Cells(lngPegarFila, lngPegarColumna), _ Cells(lngPegarFila, lngPegarColumna + 2)) _ .Select ActiveSheet.Paste lngPegarFila = lngPegarFila + 1 End If Next n 'aparcar Application.CutCopyMode = False Range("G2").Select 99: End Sub |
RSS