Macro que busca todo o parte de texto para ejecutar acción

.29/09/16

Buenas, Cecilio

Fijate si esta variante hace lo que solicitabas:

Sub MasRapidin()
Dim celda As Range
Dim palabra As String
ElRango = "G2:G1200"
palabra = "BBVA-" & "TRANSFERENCIA-" & "INTERCUENTA-" & "PRESTAMO"
For Each celda In Range(ElRango)
    If InStr(1, palabra, UCase(celda.Value)) = 0 Then celda.EntireRow.Delete
Next celda
End Sub

Dentro del código hay una variable para que le indiques el rango a revisar.

Avisame se hace lo que esperabas.

Abrazo

Fernando

.

¡Gracias! por contestar rapido

lo hace  a medias pero únicamente con las primeras 100 filas aproximadamente a pesar de que tiene que tiene la indicación que  abarque hasta el rango G1200 ,no se si tenga que ver que en algunas filas esta vacío o dicho de otra manera no tiene leyenda/texto o palabra  pero cuando no tiene leyenda o palabra alguna que se elimine por igualla fila

.

Es probable, toda vez que al eliminar filas, se achica el rango original y puede dejar líneas afuera.

La siguiente variante considera eso y, también, elimina las filas vacías.

Prueba con esta:

Sub MasRapidin()
Dim palabra As String
'---- Variables de configuración:
'=== CECILIO, modifica estos datos de acuerdo a tu proyecto:
ElRango = "G2:G1200"
palabra = "BBVA-" & "TRANSFERENCIA-" & "INTERCUENTA-" & "PRESTAMO"
'---- fin Variables
'
'---- inicio de rutina:
'  
IniCell = Left(ElRango, InStr(1, ElRango, ":") - 1)
UltFila = Range(ElRango).Rows.Count - 1
palabra = Ucase(palabra)
For fila = UltFila To 0 Step -1
    If InStr(1, palabra, UCase(Range(IniCell).Offset(fila).Value)) = 0 Or Len(Range(IniCell).Offset(fila).Value) = 0 Then Range(IniCell).Offset(fila).EntireRow.Delete
Next
End Sub

Olvidé mencionar que el procedimiento está progamado para NO considerar si las palabras están en mayúsculas o minúsculas.

Saludos

Fernando

.

ups lo único que respeta fue a donde tiene la palabra préstamo todo lo demás lo elimina a pesar de que hay filas que contiene la(s) palabra(s) Bbva , Transferencia ,Intercuenta

.

Pues, las pruebas que hice funcionan OK.

Es más, la palabra "préstamo" como la escribiste, debería ser eliminada, porque no figura con acento en la lista que pasaste.

Copia y pega de nuevo aquel código. Fíjate que no haya reemplazado el signo & por amp%

A veces lo hace.

Debería funcionar OK.

Saludos

Fer

.

¿Tienes algún correo para adjuntarte archivo?

.

Sí, señor.

Escríbeme a:

Fejoal(eenn)hotmail.com

Para enviarlo, reemplaza "(eenn)" con @ en la dirección que te dí. Es para evitar a los programas que recolectan direcciones de e-mail (ya no saben qué inventar...)

Abrazo

Fernando

.

.

Buenas, Cecilio

Me parece que había entendido al revés.

Es decir que la celda a evaluar tenía una de las palabras que detallaste, pero sólo esa palabra.

Por lo que ví en tu archivo basta que una de las palabras clave esté dentro del texto de la celda, para mantener esa fila.

Siendo así, la solución cambió un poco y podrás probarla en el archivo que te envié.

Además le agregué una instrucción que varía automáticamente el rango a evaluar según su extensión. Solo necesita saber cuál es la primera celda a evaluar.

La nueva rutina es como sigue:

Sub MasRapidin()
Dim palabra As String
'---- Variables de configuración:
'=== CECILIO, modifica estos datos de acuerdo a tu proyecto:
IniCell = "G2"
Keywords = Array("BBVA", "TRANSFERENCIA", "INTERCUENTA", "PRESTAMO")
'---- fin Variables
'
'---- inicio de rutina:
'  
UltFila = Range(IniCell).CurrentRegion.Rows.Count - 2
For fila = UltFila To 0 Step -1
    dele = True
    If Len(Range(IniCell).Offset(fila).Value) Then
        For Key = 0 To UBound(Keywords) - 1
            If InStr(1, UCase(Range(IniCell).Offset(fila).Value), UCase(Keywords(Key))) <> 0 Then
                dele = False
                Exit For
            End If
        Next
    Else
        dele = True
    End If
    If dele Then Range(IniCell).Offset(fila).EntireRow.Delete
Next
End Sub

Publico aquí, por si le sirviere a alguien más.

Saludos

Fer

.

ya lo ejecute pero no hace nada