Jump to content

Archived

This topic is now archived and is closed to further replies.

ikvergarab

Buscar celdas con cierta informacion especifica y rellenar las filas con rojo

Recommended Posts

Buenas tardes,

tengo un archivo que con información desde la columna A hasta la H y lo que quiero es una macro en la que pueda buscar las celdas que contiene cierta palabra y que toda la fila me quede en rojo, he estado intentando pero como la palabra que busco aparece en mas de una celda solo me coloca el rojo una fila y no sigue buscando las demás celdas que contengan la información. Adjunto el archivo, el código que he utilizado es

Private Sub buscar()

Dim a As String * 1

Dim rng As Range, msg As String

Dim lngFirstFreeRow As Long

Worksheets("Registro").Select

With Columns("B:B")

Set rng = .Find( _

What:=Cells(1, 11), _

LookIn:=xlValues, _

LookAt:=xlPart, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext)

rng.Select

Range(Selection, Selection.End(xlToRight)).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 255

.TintAndShade = 0

.PatternTintAndShade = 0

End With

ActiveCell.Copy

ActiveCell.Offset(0, -1).Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

End With

End Sub

pero como les comento solo lo hace con la primera celda que encuentra y yo necesito que el siga buscando que otra celda contiene la palabra y la ponga en rojo.

gracias.

Matriz LEGAL AMBIENTAL AON AGOSTO 2013 (2).zip

Share this post


Link to post
Share on other sites

Hola, pues estoy en la oficina y por una restricción no puedo bajar archivos con extensión .ZIP, así que sin ver tu archivo te dejo este código que solo debes colocar en un modulo normal y ejecutarlo en la hoja deseada el busca la palabra que esta en esta dirección "Cells(1, 11)" que seria la celda K1 y busca la palabra en la columna B para colorear la fila en rojo.

Te dejo el código, comentas si te funciono:

Sub relleno()
Application.ScreenUpdating = False
Dim celda, rango As Range
Set rango = Range("B1:B" & [B65531].End(xlUp).Row)
For Each celda In rango
If celda = Cells(1, 11) Then
With celda.EntireRow.Interior
.Color = 255
End With
End If
Next
End Sub[/PHP]

Salu2

Share this post


Link to post
Share on other sites

Bueno ahora que llego a mi casa le echo un ojo xq aquí en la oficina no puedo descargar tu archivo aunque debería funcionar funciona con este ejemplo:

- - - - - Mensaje combinado - - - - -

Tambien puedes probar este este codigo en lugar del primero:

Sub relleno()
Application.ScreenUpdating = False
Dim celda, rango As Range, d As String
Set rango = Range("B1:B" & [B65531].End(xlUp).Row)
For Each celda In rango
If InStr(1, celda, Cells(1, 11)) Then
With celda.EntireRow.Interior
.Color = 255
End With
End If
Next
End Sub[/PHP]

Salu2

[color=blue]- - - - - Mensaje combinado - - - - -[/color]

Hola ya lo probé en tu archivo y el segundo código que menciono funciona a la perfección

Salu2

EJEM.rar

Share this post


Link to post
Share on other sites

es cierto la macro funciona... pero me di cuenta es que en mi archivo la palabra que busco debe de estar contenida en una celda, es decir, que por ejemplo en una celda dice "Consumo de agua en cartagena" y otra que dice "Viviendas con Consumo de energia" y lo que yo quisiera es que todas las celdas que contengan la palabra "Consumo" sus respectivas filas sean rellenadas con color rojo

Share this post


Link to post
Share on other sites

Hola, eso es exactamente lo que hace el segundo codigo que te deje:

Sub relleno()
Application.ScreenUpdating = False
Dim celda, rango As Range, d As String
Set rango = Range("B1:B" & [B65531].End(xlUp).Row)
For Each celda In rango
If InStr(1, celda, Cells(1, 11)) Then
With celda.EntireRow.Interior
.Color = 255
End With
End If
Next
End Sub [/PHP]

Adjunto ejemplo en el que veras que en las celdas con oraciones que contienen la palabra "casa" pintan de rojo toda la fila.

EJEM2.rar

Share this post


Link to post
Share on other sites

Hola solo cambias una linea, el código quedaría así:

Sub relleno()Application.ScreenUpdating = False
Dim celda, rango As Range, d As String
Set rango = Range("B1:B" & [B65531].End(xlUp).Row)
For Each celda In rango
If InStr(1, celda, Cells(1, 11)) Then
With Range("A" & celda.Row & ":I" & celda.Row).Interior
.Color = 255
End With
End If
Next
End Sub[/CODE]

Salu2

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




  • Posts

    • Saludos Abrahan estos son los errores al abrir el archivo,me dices si te va de algo o aun asi necesitas el codigo xml que uso para cargar la ribbon aunque como te comente me funciona muy bien en las maquinas donde no hice ninguna desinstalacion,lo que indica que el codigo xml no es el problema en si,por eso creo que se esta dndo una incompatibilidad por haber tenido antes office 2010,que opinas mi amigo
    • buenas tardes antes que nada agradecer por el tiempo que se toman en apoyarnos con nuestras dudas bueno mi consulta es la siguiente tengo una tabla y quisiera que al momento de escribir los datos en la celdas de arriba (algo como un buscador me filtre la información que estoy buscando) les dejo un ejemplo para que se pueda entender mejor espero puedan ayudarme muchas gracias. ejemplo.xlsx
    • ¡Hola a ambos! @joselica:  Quizá lo que te muestro en el adjunto te pone en perspectiva para lo que estás pidiendo.  En lo que adjunto, debes tener en cuenta que los cambios debes hacerlos en el rango manual (a la derecha), para que éste se vea reflejado en la parte izquierda. De igual forma, ten en cuenta la columna "orden", la cual determina el orden en ese día con respecto a los turnos.  ¡Comentas! ¡Bendiciones! Turnos.xlsx
    • Hola, les explico la problemática que tengo con una pequeña macro, esta Macro la ocupo para buscar y remplazar, me funciona muy bien con una condicionante, pero estoy intentando colocar 2 condicionantes y ahí es donde estoy atorado. Set h1 = Sheets("BD SALIDAS") Set b = h1.Range("A:A").Find(REMISION) If Not b Is Nothing Then End If Set d = h1.Range("C:C").Find(LOTE) If Not d Is Nothing Then h1.Cells(d.Row, "F") = (SALIDASLT) End If lo que busco es que la Macro encuentre el LOTE y que coincida con la REMISIÓN para poder sustituir el dato del TEXTBOX a la celda. agradezco mucho su ayuda.
    • Buenas tardes. Por favor necesito su ayuda para poder resolver lo siguiente: Necesitamos que busque la referencia de la Hoja UNO Celda F3 en otra hoja dos y concatenen todas las lineas D2_C2_G2 ambace a la referencia de la hoja uno Quedaría así. Gracias. Prueba..xlsx
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy