martes, 10 de abril de 2018

VBA: Contar días alternos transcurridos

Días atrás un usuario planteaba una cuestión interesante a través de un comentario.
Preguntaba por la forma de obtener un día final considerando solo ciertos días hábiles de la semana.
[...]Como puedo conocer la fecha final , a partir de una fecha inicial , con un número de días?
Pero sólo quiero contar los días lunes, miércoles y viernes. Ejemplo: hoy tengo un inventario de 10 pastillas de un medicamento. Tengo que tomarme una sola pastilla por día. Pero sólo me la tomo los lunes, miércoles y viernes. Por lo tanto tengo un inventario de 10 días de medicamentos. Pero no son continuos . Ya q la tomo son los lunes, miércoles y viernes.
Como hago para saber hasta qué fecha tengo pastillas ?[...]


La idea está bien expresada por el lector, a partir de una fecha dada, por ejemplo 3 de enero de 2018, si contamos 10 días teniendo en cuenta solo Lunes, Miércoles y Viernes, cuál sería el último día en que finalizaría ??.
Esto es, cuál es la fecha final teniendo en cuenta ciertos días hábiles dentro de la semana.

VBA: Contar días alternos transcurridos



En la imagen he coloreado en amarillo los diez días habilitados...
Nuestra fórmula incluida en la celda C10 es:
=DiasAlternos(B10;10;1;0;1;0;1;0;0)

que como se observa tiene declarada como primer argumento argumento (Fecha de partida) la celda B10.
El segundo argumento el número de días hábiles a considerar (en el ejemplo 10).
Y los siguientes siete argumentos permiten VERDADERO y FALSO (1 y 0) para indicar cuáles son esos días hábiles; para el ejemplo lunes, miércoles y viernes...


Generaremos una función personalizada con algo de código simple.

En un módulo estándar del libro incluimos el siguiente procedimiento:

Function DiasAlternos(FechaInicial As Date, NumDias As Long, _
                        Optional lun As Boolean = True, _
                        Optional mar As Boolean = True, _
                        Optional mie As Boolean = True, _
                        Optional jue As Boolean = True, _
                        Optional vie As Boolean = True, _
                        Optional sab As Boolean = True, _
                        Optional dom As Boolean = True) As Date
'la función opera con dos argumentos obligatorios
'FechaInicial que será la fecha de partida
'NumDias que es el número de días a incrementar

'con siete argumentos opcionales
'con valor predeterminado de VERDADERO
'indicaremos 0 ó FALSO si no queremos considerarlo en el conteo
'indicaremos 1 ó VERDADERO si sí queremos considerarlo en el conteo

'definimos las variables a usar
Dim FechaFinal As Date, contador As Long
contador = 0

'recorremos una a una las fechas desde la Fecha de partida
'hasta
For fecha = (FechaInicial) To ((FechaInicial + NumDias * 7))
    'mantenemos el recorrido mientras no lleguemos al límite de días estipuladdo en la función
    If contador < NumDias Then
        'incrementamos la fecha según las elección del usuario
        'indicada en los siete argumentos
        If Weekday(fecha, vbMonday) = 1 And lun Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 2 And mar Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 3 And mie Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 4 And jue Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 5 And vie Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 6 And sab Then
            FechaFinal = fecha
            contador = contador + 1
        ElseIf Weekday(fecha, vbMonday) = 7 And dom Then
            FechaFinal = fecha
            contador = contador + 1
        End If
    End If
Next fecha
'finalmente devolvemos a la función el valor de la fecha...
DiasAlternos = FechaFinal
                       
End Function

Como podemos comprobar el resultado es el esperado...

2 comentarios:

  1. Ismael por favor resolverlo con funciones.
    Gracias

    ResponderEliminar
    Respuestas
    1. Hola Eduardo,
      con funciones estándar sería muy complejo.. por eso opté por una UDF
      Le daré una segunda vuelta en todo caso
      Saludos

      Eliminar