30 julio, 2021

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.

Donate Button with Credit Cards

¡¡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

Comparte este post

Si te ha gustado o tienes alguna duda, puedes dejar aquí tu comentario.

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies