Macro para comparar las fechas de una columna con la actual?

En la columna R tengo celdas vacias y celdas con fechas, lo que quiero hacer es que se compare la fecha de cada una de las celdas de esa columna con la fecha actual y asi en la columna S se ponga un 1 si la fecha es menor que la actual (es decir ya se vencio) o un 0 si la fecha aun no pasa (es decir no se ha vencido), en el caso de las celdas vacias que arroje un 3

3 Respuestas

Respuesta
1

Janeth Marquez,

Adjunto código macros correspondiente a la solución de tu consulta para su revisión.

Sub CompararFechas()
UltimaFila = Range("R" & Rows.Count).End(xlUp).Row
For i = 1 To UltimaFila
If IsDate(Range("R" & i)) = True Then
    If Range("R" & i) = "" Then
        Range("S" & i) = 3
    Else
        If Range("R" & i) < Date Then
            Range("S" & i) = 1
        Else
            Range("S" & i) = 0
        End If
    End If
Else
    Range("S" & i) = ""
End If
Next i
End Sub

Espero que te sirva de ayuda y este acorde a tus necesidades. Cualquier consulta estaré pendiente.

Respuesta
1

Si mal no te entendí, y suponiendo que tus datos comienzan en la celda "R2", algo así te servirá:

Sub Fechas()
Dim Celda As Range
Dim UltimaFila As Long
Let UltimaFila = Cells(Rows.Count, 18).End(xlUp).Row
For Each Celda In Range("R2:R" & UltimaFila)
    If IsDate(Celda.Value) Then
        Select Case Celda.Value
            Case Is < Date
            Celda.Offset(0, 1) = 1
            Case Is > Date
            Celda.Offset(0, 1) = 0
        End Select
    Else
        Celda.Offset(0, 1) = 3
    End If
Next Celda
End Sub

Comentas

Abraham Valencia

Respuesta
1

Te pongo una macro que hace lo que pides

Sub compara_fechas()
CUENTA = WorksheetFunction.CountA(Range("r:R"))
cuenta_vacios = WorksheetFunction.CountBlank(Range("r1:r" & CUENTA))
filas = CUENTA + cuenta_vacios:     fecha_actual = Date
Set DATOS = Range("r1:r" & filas)
With DATOS
    .Columns(2).Clear
    For I = 1 To filas
        fecha = .Cells(I, 1)
        If fecha < fecha_actual Then
            .Cells(I, 2) = 1
        Else
            .Cells(I, 2) = 0
        End If
        If fecha = Empty Then .Cells(I, 2) = 3
    Next I
End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas