Funcion dias festivos

Tengo una función que calcula días laborables de lunes a Viernes entre dos fechas de la siguiente forma:
Function Dias_Laborables(ByVal fecha_inicio As Date, ByVal fecha_fin As Date) As Integer
Dim i As Variant
Dim num_dias As Integer
On Error GoTo controladorErrorDias 'Establece control error
'Calculo de dias laborables:'Eliminar sabados y Domingos
For i = fecha_inicio To fecha_fin
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
num_dias = num_dias + 1
End If
Next i
Dias_Laborables = num_dias
Exit Function
controladorErrorDias: 'Etiqueta linea de controlador error.
Resume Next 'Reanudar procedimiento.
Lo que quiero es a la inversa. Es decir, que calcule Sábados y Domingos entre 2 fechas. ¿De qué forma debo modificarla?.
Por otro lado, en la función original, ¿Qué debo hacer para que, ademas de Sábados y Domingos, me excluya los días de calendario que yo le indique?
3

3 respuestas

Respuesta
1
La primera pregunta simplemente con cambiar el <> por el = te contara los sábados y domingos.
La segunda dentro del buble tendrás que ir a buscar la fecha en una tabla de festivos y si no la encuentras lo cuentas, fácil
Tendrás que disculpar mi ignorancia, ya que a pesar de que te he copiado la función, me estoy iniciando en VB y no la acabo de entender bien.
He sustituido <> por = en las 2 expresiones en que esta, pero el resultado me da 0.
En cuanto a los días de calendario que deseo excluir, ¿Qué es un "buble"?. Tengo claro que debo crear una tabla con dichos días, pero ¿Cómo de qué forma tengo que invocarla en la expresión?
Gracias por tu tiempo
En cuanto a lo primero ademas de cambiar el = debes cambiar el "and" por el "or", perdón por no haberme dado cuenta
La segunda cuestión
Primero abres la tabla
Dim zona34 As Recordset
Set zona34 = MiBaseDeDatos.OpenRecordset("datoscalendario", DB_OPEN_DYNASET) ' Crea Recordset.
Detro del bucle (for next)
Lees la fecha
criterios = "feccalendario = #" & Format(i, "mm/dd/yy") & "#"
'MsgBox criterios
Zona34. FindFirst criterios ' Busca primera aparición.
If zona34.NoMatch Then
'aquí colocas el conteo ya que esta condición supone que la fecha no esta en la tabla
Endif
Respuesta
1
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
dim mibd as dao.database
dim mirs as dao.recordset
dim encontrado as boolean
set mibd=currentdb()
set mirs=mibd.openrecordset("select * from tablaFestivos")
mirs.movefirst
encontrado=false
while not mirs.eof and not encontrado
if mirs.fields("dia_festivo")=i then 'Fecha corriente en el bucle FOR
encontrado=true
else
mirs.movenext
endif
wend
mirs.close
set mirs=nothing
set mibd=nothing
if not encontrado then
num_dias = num_dias + 1
endif
End If
Más o menos, ha de funcionar.
Gracias por tu rápida respuesta.
He pegado todo el código que me has pasado a partir de :
"dim mibd as dao.database", he sustituido "tablaFestivos" por el nombre de la tabla en mi BD, he sustituido "dia_festivo" por el nombre del campo que contiene la fecha en la tabla de mi BD, pero el intentar ejecutar la función, en la primera linea "dim mibd as dao.database", me da un error de compilación "No se ha definido el tipo definido por el usuario".
¿Por donde van los tiros"
Gracias
Tu editor VB no tiene incluida la referencia a la librería DAO de acceso a datos. Desde el menú herramientas->referencias, le incluyes la librería Microsoft DAO+(la versión que tengas más moderna), y ya está.
Hola de nuevo.
He incorporado la librería que sugieres, pero sigue dando errores de compilación, For sin next, ausencia de endif, wend sin while, etc.
Creo que en la función está todo, aunque no en el orden correcto, ya que no estoy muy ducho en código. Te la transcibo tal cual está, y a ver si le puedes pillar donde falla:
Option Compare Database
Function Dias_Laborables_2(ByVal fecha_inicio As Date, ByVal fecha_fin As Date) As Integer
Dim i As Variant
Dim num_dias As Integer
On Error GoTo controladorErrorDias 'Establece control error
'Calculo de dias laborables:'Eliminar sabados y Domingos
For i = fecha_inicio To fecha_fin
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
Dim mibd As DAO.database
Dim mirs As DAO.Recordset
Dim encontrado As Boolean
Set mibd = CurrentDb()
Set mirs = mibd.openrecordset("select * from dias_Festius")
mirs.MoveFirst
encontrado = False
While Not mirs.EOF And Not encontrado
If mirs.Fields("Fecha") = i Then 'Fecha corriente en el bucle FOR
encontrado = True
Else
mirs.MoveNext
End If
Wend
mirs.Close
Set mirs = Nothing
Set mibd = Nothing
If Not encontrado Then
num_dias = num_dias + 1
End If
Next i
Dias_Laborables = num_dias
Exit Function
controladorErrorDias: 'Etiqueta linea de controlador error.
Resume Next 'Reanudar procedimiento.
End Function
Gracias
A ver, te he revisado la sintaxis de la función y he arreglado algunos problemas...
Ahora a mi me funciona...
Private Sub Comando3_Click()
MsgBox Dias_Laborables_2(Now, Now + 10)
End Sub
Function Dias_Laborables_2(ByVal fecha_inicio As Date, ByVal fecha_fin As Date) As Integer
Dim i As Variant
Dim num_dias As Integer
Dim mibd As DAO.Database
Dim mirs As DAO.Recordset
Dim encontrado As Boolean
On Error GoTo controladorErrorDias 'Establece control error
Set mibd = CurrentDb()
'Calculo de dias laborables:'Eliminar sabados y Domingos
For i = fecha_inicio To fecha_fin
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
Set mirs = mibd.OpenRecordset("select * from dias_Festius")
mirs.MoveFirst
encontrado = False
While Not mirs.EOF And Not encontrado
If Format(mirs.Fields("Fecha"), "dd-mm-yy") = Format(i, "dd-mm-yy") Then 'Fecha corriente en el bucle FOR
encontrado = True
Else
mirs.MoveNext
End If
Wend
If Not encontrado Then
num_dias = num_dias + 1
End If
End If
Next i
mirs.Close
Set mirs = Nothing
Set mibd = Nothing
Dias_Laborables_2 = num_dias
Exit Function
controladorErrorDias: 'Etiqueta linea de controlador error.
Resume Next 'Reanudar procedimiento.
End Function
Esta función devuelve los días laborables existentes entre la fecha del día y diez días más. Si entre la fecha de hoy y la de dentro de diez días no encuentra ningún registro en la tabla dias_festius (campo fecha), la función devolverá 10. Si encuentra un día festivo, devolverá 9, etc, etc.
Luego tu ya le tendrás que meter, viendo la lógica, que tenga en cuenta los sábados y domingos, etc.
Respuesta

Descargue e instale el manual y ejemplos para Access y Excel del siguiente link:

https://mega.nz/#!TMkFES6D!6RGkDnt_1lG6V5RkDMYxE3KBpZIwm3UECAMuIcjbf_Q 

Encontará código sobre el cálculo de días habiles y mucho más, está para Colombia pero con pequeños cambios sirve para cualquier paìs.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas