Semáforo con Fechas En Excel
Espero que te encuentres muy bien y de antemano agradezco toda la ayuda que me has brindado en las respuestas realmente han sido muy útiles.
Hace poco me ayudaste con la siguiente pregunta:
Quisiera conocer el código para un macro que deseo hacer, y es básicamente un semáforo que depende de las fechas.
Para el ejemplo anterior, quisiera que el código validara la fecha que se encuentra en A3<$B$1, el rango de B3:E3 sea ROJO, pero que si A3=$B$1, el rango de B3:E3 sea AMARILLO, Y por ultimo A3>$B$1, el rango de B3:E3 sea Verde, y así sucesivamente hasta la ultima fecha.
Para lo cual, tu me respondiste el siguiente código:
Sub Semaforo()
'Por.Dante Amor
fecha = Range("B1").Value
uc = Cells(2, Columns.Count).End(xlToLeft).Column
Set rango = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each fec In rango
Select Case fec.Value
Case Is < fecha
Range(Cells(fec.Row, "B"), Cells(fec.Row, uc)).Interior.ColorIndex = 3
Case Is = fecha
Range(Cells(fec.Row, "B"), Cells(fec.Row, uc)).Interior.ColorIndex = 6
Case Is > fecha
Range(Cells(fec.Row, "B"), Cells(fec.Row, uc)).Interior.ColorIndex = 4
End Select
Next
MsgBox "Fin"
End Suby para el código anterior la macro esta haciendo parte de lo que quiero lograr. Quiero aplicar esta macro sobre una Tabla dinámica, y me esta generando el siguiente resultado
Para lo anterior, me gustaría que la macro hiciera dos cosas.
La primera es que se detenga en la ultima fecha, es decir, en la fila 23. (O la ultima fila con fecha, es decir, que hasta que encuentre en blanco, se detenga)
La segunda, es que el color lo aplicara hasta la columna "F".
¿Es posible realizar estos cambios?.
1 Respuesta
Te anexo la macro actualizada
Sub Semaforo()
'Por.Dante Amor
fecha = Range("I16").Value 'Celda con la fecha
fila = 22 'fila inicial de la tabla
ult_col = "N" 'última columna de la tabla
Do While True
If Cells(fila, "A") = "" Then Exit Do
If Cells(fila, "A") <> "Total general" And Cells(fila, "A") <> "(en blanco)" Then
Select Case Cells(fila, "A").Value
Case Is < fecha
Range(Cells(fila, "B"), Cells(fila, ult_col)).Interior.ColorIndex = 3
Case Is = fecha
Range(Cells(fila, "B"), Cells(fila, ult_col)).Interior.ColorIndex = 6
Case Is > fecha
Range(Cells(fila, "B"), Cells(fila, ult_col)).Interior.ColorIndex = 4
End Select
End If
fila = fila + 1
Loop
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias!
Hola Dante, los cambios esta perfecta la macro, realmente es lo que necesito
Muchas Muchas gracias por toda tu ayuda
