Macro para buscar una lista de palabras en un texto
Cuento con una serie de textos en filas consecutivas (noticias) en "Hoja1" a partir de C3 y pueden llegar a 1000 o más... En "Hoja2" a partir de A1 tengo una lista de palabras (errores ortográficos concretos) que aumentará con el tiempo.
Necesito una macro que me busque las palabras de Hoja2 en las noticias de Hoja1 y las resalte en rojo y negritas.
Revisé una macro que hace esto último, pero no me permite buscar a través de una lista de palabras:
Sub ResaltarPalabras()
Dim Celda As Range
Dim palabra As String
palabra = InputBox("Palabra a buscar")
For Each Celda In Selection
posicion = InStr(1, Celda.Value, palabra)
Do Until posicion = 0
Celda.Characters(posicion, Len(palabra)).Font.Color = vbRed
Celda.Characters(posicion, Len(palabra)).Font.Bold = True
posicion = posicion + 1
posicion = InStr(posicion, Celda.Value, palabra)
Loop
Next Celda
End Sub
Si me pudieras ayudar.
2 respuestas
Ésta es la "Hoja1". En la columna C vienen los textos consecutivos que pueden sumar hasta 1000. Imagina que debes encontrar errores en cada uno de ellos...
Éste es un ejemplo de la "Hoja2". Las palabras o frases vienen una tras otra en cada renglón. Crecerá con el tiempo.
Si la macro logra resaltar las palabras y frases erróneas, mis ojos te lo agradecerán.
Yo te decía un archivo para poder ir probando y no tener que intentar recrear/simular tus datos que es casi casi un trabajo a parte mi estimado amigo.
Otras cosas que quedaron, también, sin saberse:
- En esa columna "C" lo que tu llamas "errores" ¿puede repetirse el mismo en una misma celda? Es decir ¿en "C3" podría hacer una, dos o más veces "este domingo"?
- Los llamados "errores" ¿en las celdas de la columna "C" son tal cuales aparecen en tu "Hoja2"? ¿Puede haber alguno que tenga algún carácter distinto pero igual quieras que se "resalte"?
Abraham Valencia
Hola Abraham. No encuentro cómo adjuntar un archivo aquí, pero cuando sepa, lo haré con tal de facilitar las cosas.
Cierto, los "errores" pueden repetirse más de una vez en la celda. Los errores serían tal como aparecen en la "Hoja2". Hay uno en especial que es la arroba seguida de un espacio ('@ ') la cual me impide identificar cuentas de Twitter, por ejemplo.
Agradezco tu tiempo y dedicación. Saludos cordiales.
Intenta con algo así:
Sub BuscarErrores()
Dim CeldaBusqueda As Range, CeldaDato As Range
Dim FraseaBuscar As String
Dim Posicion As Integer
Dim UltimaFila As Long
Let UltimaFila = Cells(Rows.Count, 1).End(xlUp).Row
For Each CeldaBusqueda In Range("A1:A" & UltimaFila)
For Each CeldaDato In Range("F1:F5")
Let FraseaBuscar = CeldaDato.Value
Let Posicion = InStr(1, CeldaBusqueda.Value, FraseaBuscar)
Do Until Posicion = 0
CeldaBusqueda.Characters(Posicion, Len(FraseaBuscar)).Font.Color = vbRed
CeldaBusqueda.Characters(Posicion, Len(FraseaBuscar)).Font.Bold = True
Posicion = Posicion + 1
Posicion = InStr(Posicion, CeldaBusqueda.Value, FraseaBuscar)
Loop
Next CeldaDato
Next CeldaBusqueda
End SubOJO, aquí cambia el 1 por un 3 (columna "C"):
Let UltimaFila = Cells(Rows.Count, 1).End(xlUp).Row
Y aquí:
For Each CeldaDato In Range("F1:F5")
Cámbialo por la hoja y rango de tus errores, algo así: Sheets("Hoja2"). Range("A1:A12")
Comentas
Abraham Valencia
Estimado Abraham, la macro funcionó a la perfección, con los debidos cambios.
No tengo cómo agradecer tu ayuda.
Saludos desde México.
Atte. José Tolentino
Perfecto, feliz año :)
Abraham Valencia
Como estás con estos ejemplos podrás armar tu macro