Macro que me avise el vencimiento de una fecha pasada 3 días

Para Dante Amor,

Mi caso es el siguiente:

Tengo una hoja de calculo donde en la fila "b" (desde B2 hasta B115) tengo fecha de inicio y en la fila "c" (desde C2 hasta C115) fecha de cierre, y cuando ingrese una fecha en fecha de inicio lo que necesito es que pasado tres días me avise pintándose de rojo la celda, pero que no me cuente los domingos y en ocasiones en la fila de fecha de cierre llego anotar pendiente o en proceso y que esas no se pinten.

Espero me puedas ayudar y si no me explique bien te pido me avises.

1 Respuesta

Respuesta
2

Reviso el archivo y empiezo a elaborar la macro, cuando la tenga te la envío

ok muchas gracias 

Te anexo 2 macros que va en los eventos de thisworkbook, ambas funcionan solamente para las hojas "SWAP INST" y "LTE INST ", si quieres que funcione para más hojas, deberás modificar ambas macros; en esta línea agrega las siguientes hojas:

Case "SWAP INST", "LTE INST "

Por, ejemplo si quieres agregar la hoja "MICROBTS ", la línea en ambas macros deberá quedar así:

Case "SWAP INST", "LTE INST ", "MICROBTS "

Nota: Revisa el nombre de tus hojas, porque en varias tienes al final del nombre un espacio.


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Por.Dante Amor
    Select Case Sh.Name
    Case "SWAP INST", "LTE INST "
        Application.ScreenUpdating = False
        u = Range("B" & Rows.Count).End(xlUp).Row
        Range("B2:B" & u).Interior.ColorIndex = xlNone
        For i = 2 To u
            n = 0
            If IsDate(Cells(i, "B")) Then
                For j = Cells(i, "B") To Date
                    If n >= 3 Then
                        Cells(i, "B").Interior.ColorIndex = 3
                    End If
                    If Not Weekday(Cells(i, "B"), 1) Then
                        n = n + 1
                    End If
                Next
            End If
        Next
    End Select
End Sub
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Por.Dante Amor
    Select Case Sh.Name
    Case "SWAP INST", "LTE INST ", "MICROBTS "
        If Not Intersect(Target, Range("B:B")) Is Nothing Then
            If Target.Count > 1 Then Exit Sub
            Target.Interior.ColorIndex = xlNone
            If IsDate(Target.Value) Then
                n = 0
                For j = Target.Value To Date
                    If n >= 3 Then
                        Target.Interior.ColorIndex = 3
                    End If
                    dia = Weekday(Target, 1)
                    If Not Weekday(Target, 1) Then
                        n = n + 1
                    End If
                Next
            End If
        End If
    End Select
End Sub

Para ver las macros:

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y ver la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook

Saludos. Dante Amor

Si es lo que necesitas.

Hola Dante muchas gracias, funciona muy bien puesto que no marca error, solo que quedo al revés y  tengo una duda, la fila que quiero se marque es la "C" que es la fecha de cierre, por lo general las celdas de la fila "C" a veces las tengo ya con una fecha de cierre y para no estar buscando cual excedió el plazo entonces al paso de los 3 días de la fecha de inicio que tengo en la fila "B"  se pinten, y se podrá que no importa que vaya a la fecha de hoy? si no que cumpla la función de que pasando 3 días me avise por que por ejemplo tengo una fecha 18/ene/15 y cerro el día 20/ene/15 entonces ahí no excedió los 3 días de plazo pero aun así se pinto, y otra duda ¿tengo que ejecutar la macro o automáticamente los marcara? te agradezco mucho por tu atención y si no me explique bien te pido me lo hagas saber.

Saludos..

Para que funcione contra la fecha de cierre, deberás poner únicamente una fecha, y en tu celda estás poniendo una fecha y un comentario. Tendrás que poner el comentario en otra celda.

Modifica tu archivo para dejar únicamente fechas en la fecha de cierre y me lo envías nuevamente.

Las macros se ejecutan en automático.

Muchas gracias Dante por contestar, en un momento to lo envío

Te anexo las nuevas macros

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Por.Dante Amor
    Select Case Sh.Name
    Case "SWAP INST", "LTE INST ", "MICROBTS "
        Application.ScreenUpdating = False
        u = Range("C" & Rows.Count).End(xlUp).Row + 1
        Range("C2:C" & u).Interior.ColorIndex = xlNone
        For i = 2 To u
            n = 0
            If IsDate(Cells(i, "B")) And IsDate(Cells(i, "C")) Then
                For j = Cells(i, "B") To Cells(i, "C")
                    If n >= 3 Then
                        Cells(i, "C").Interior.ColorIndex = 3
                    End If
                    If Not Weekday(Cells(i, "B"), 1) Then
                        n = n + 1
                    End If
                Next
            End If
        Next
    End Select
End Sub
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Por.Dante Amor
    Select Case Sh.Name
    Case "SWAP INST", "LTE INST ", "MICROBTS "
        If Not Intersect(Target, Range("B:C")) Is Nothing Then
            If Target.Count > 1 Then Exit Sub
            Range("C" & Target.Row).Interior.ColorIndex = xlNone
            If IsDate(Range("B" & Target.Row)) And IsDate(Range("C" & Target.Row)) Then
                n = 0
                For j = Range("B" & Target.Row) To Range("C" & Target.Row)
                    If n >= 3 Then
                        Range("C" & Target.Row).Interior.ColorIndex = 3
                    End If
                    dia = Weekday(Target, 1)
                    If Not Weekday(Target, 1) Then
                        n = n + 1
                    End If
                Next
            End If
        End If
    End Select
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas