24 septiembre, 2023

FUNCIÓN PARA GENERAR N DÍAS LABORABLES, FINES DE SEMANA O DÍAS NATURALES

Hola a todos!:

El último fin de semana he estado ausente, me he tenido que centrar en asuntos que requerían atención y no he podido realizar publicaciones.

Hoy, después de enviar una función a un lector, he decidido compartirla aquí para todos. Se trata de una función con la que vamos a poder generar cadenas de días según las siguientes 3 tipologías: (Sábados y Domingos, Días laborables, Días naturales (todos)).

La función que he implementado utiliza la instrucción select case para determinar el tipo que vamos a generar. Consta de 3 argumentos.

1- Fecha de inicio. Es la fecha con la que vamos a comenzar, se genera el día.
2- Número de días a generar. Es el número de días que queremos añadir a la cadena.
3 Tipo de cadena. Debe ser del 1 al 3 conforme a las tipologías descritas.
– 1: Sábados y Domingos.
– 2: Días Laborables.
-3: Días naturales.

Esta es la función que he creado para realizar esta tarea:

Function DAYSTRING(ByVal inicio As Date, num As Long, tipo As Integer)
    'Declaramos variables
    Dim nCont       As Date
    Dim sCadena     As String, fsem As String
    Dim matriz      As Variant, j As Long
    Dim miArray     As Variant, n As Long
    With ActiveSheet
        inicio = DateSerial(Year(inicio), Month(inicio), Day(inicio) - 1)
        n = 1
        Do While n <= num
            nCont = DateAdd("w", 1, inicio)
            inicio = nCont
            fsem = Format(inicio, "ddd")
            'caso 1 se generan fechas de los próximos sábados y domingos
            Select Case tipo
                Case 1
                    If fsem = "sá." Or fsem = "do." Then
                        sCadena = Trim(sCadena & " " & inicio)
                        n = n + 1
                    End If
                    'caso 2 se generan fechas de los días laborables
                Case 2
                    If fsem <> "sá." And fsem <> "do." Then
                        sCadena = Trim(sCadena & " " & inicio)
                        n = n + 1
                    End If
                    'caso 3 se generan todos los días
                Case 3
                    sCadena = Trim(sCadena & " " & inicio)
                    n = n + 1
                    'numero mayor que 3 muestra error y explicación
                Case Else
                    GoTo etiqueta:
            End Select
            If n > num Then Exit Do
        Loop
        'pasamos la información de la matriz a la hoja
        matriz = Split(sCadena, " ")
        ReDim miArray(0 To UBound(matriz))
        For j = 0 To UBound(matriz)
            miArray(j) = Format(matriz(j), "dd/mm/yyyy")
        Next j
        DAYSTRING = Application.Transpose(miArray)
    End With
    Exit Function
etiqueta:
    DAYSTRING = "Error. El tercer argumento debe ser entre 1 y 3. El 1: Genera sábados y domingos, El 2: Genera días de la semana (laborables), y el 3 todos los días"
End Function

Por ejemplo, si queremos las 15 siguientes fechas a partir de hoy, la función nos dará esto en los tres casos:

He incluido una columna con el texto del día para que podáis verificar que la función extraer correctamente lo que necesitamos.

Y esto es todo, espero que sea de utilidad!, ya sea aplicando la función o utilizando partes del código.

Puedes descargar la hoja Excel desde aquí:

¿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