OBTENER RELACIÓN DE SEMANAS ENTRE DOS FECHAS CON VBA

Hola a todos, espero que estéis bien!.

El post de hoy será la contestación a una consulta que me han realizado. Se trata de obtener las semanas que hay entre dos fechas. El resultado será el del primer día de la semana como lunes y el último como domingo.

La consulta solicitaba la información para obtener las semanas de un año, pero he programado la herramienta para hacerlo para cualquier rango de fechas.

Cuando se produce el cambio de año, la columna fin cortará la fecha a 31/12 de ese año e iniciará el siguiente registro el día 1 del año siguiente (así me lo solicitaron).

Por ejemplo, las semanas entre entre 01/01/2021 y el 15/07/2021. Este sería el resultado:

La rutina que he creado completará la primera semana hasta el domingo más cercano y de ahí en adelante de lunes a domingo.

Os dejo el código:

Sub SEMANAS()
    Dim i           As Long
    With Sheets("Hoja1")
        'si la fecha inicial es mayor que la final, salimos del proceso
        If .Cells(2, 5) > .Cells(2, 6) Then Exit Sub
        'Igualamos la fecha inicial a la primera fecha del listado
        .Cells(2, 1) = .Cells(2, 5)
        'Iniciamos loop hasta que la fecha inicial sea mayor que la fecha de la columna A
        i = 2
        Do Until .Cells(i, 1) > .Cells(2, 6)
            'Realizamos cálculos
            If Year(.Cells(i, 1)) <> Year(DateSerial(Year(.Cells(i, 1)), Month(.Cells(i, 1)), Day(.Cells(i, 1)) + IIf(Weekday(Cells(i, 1), 2) < 7, 7 - Weekday(Cells(i, 1), 2), 0))) And Month(DateSerial(Year(.Cells(i, 1)), Month(.Cells(i, 1)), Day(.Cells(i, 1)) + IIf(Weekday(Cells(i, 1), 2) < 7, 7 - Weekday(Cells(i, 1), 2), 0))) = 1 Then
                Cells(i, 2) = DateSerial(Year(.Cells(i, 1)), Month(1), Day(1))
                .Cells(i + 1, 1) = DateSerial(Year(.Cells(i, 2)), Month(.Cells(i, 2)), Day(.Cells(i, 2)) + 1)
            Else
                .Cells(i, 2) = DateSerial(Year(.Cells(i, 1)), Month(.Cells(i, 1)), Day(.Cells(i, 1)) + IIf(Weekday(Cells(i, 1), 2) < 7, 7 - Weekday(Cells(i, 1), 2), 0))
                .Cells(i + 1, 1) = DateSerial(Year(.Cells(i, 2)), Month(.Cells(i, 2)), Day(.Cells(i, 2)) + 1)
            End If
            i = i + 1
        Loop
        'eliminamos elemento de la columna A en el último registro.
        .Cells(i, 1) = ""
    End With
End Sub

Como podéis observar se trata utilizar la función DateSerial() para crear las fechas sumando los días necesarios.

Y esto es todo, espero que os sea de utilidad.

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies