¿Quién quiere este código? CONTAR DIFERENCIA DÍAS LABORABLES Y FESTIVOS

tecniCam
18 de Julio del 2004
En un formulario, colocar 2 cuadros de texto que se llamen DESDE y HASTA, puedes colocarle dos etiquetas con Caption igual (Desde y Hasta).
Colocar un botón y 5 etiquetas (Label1, 2, etc.)

Pegar este código en el formulario:

Option Explicit

Function laborables(desde As Date, hasta As Date) As Integer
Dim totalDias, domingos, sabados, semanas
Dim numDia, dias, labor, noLaborables
totalDias = DateDiff("d", desde, hasta)
semanas = Int(totalDias / 7)
numDia = Weekday(desde)
dias = totalDias Mod 7
sabados = 0
domingos = 0
If totalDias >= 7 Then
sabados = semanas
domingos = semanas
End If
If dias = 6 Then
If numDia = 2 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 5 Then
If numDia = 2 Then
sabados = sabados
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
ElseIf numDia = 3 Then
sabados = sabados + 1
domingos = domingos
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 4 Then
If numDia = 2 Or numDia = 3 Then
sabados = sabados
domingos = domingos
ElseIf numDia = 4 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 3 Then
If numDia = 6 Or numDia = 7 Then
sabados = sabados + 1
domingos = domingos + 1
ElseIf numDia = 5 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
If dias = 2 Then
If numDia = 7 Then
sabados = sabados + 1
domingos = domingos + 1
ElseIf numDia = 6 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
If dias = 1 Then
If numDia = 7 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
noLaborables = sabados + domingos
laborables = totalDias - noLaborables
End Function


Private Sub Command1_Click()
Dim totalDias, domingos, sabados, semanas
Dim numDia, dias, laborables, noLaborables
totalDias = DateDiff("d", desde, hasta)
semanas = Int(totalDias / 7)
numDia = Weekday(desde)
dias = totalDias Mod 7
laborables = 0
sabados = 0
domingos = 0
If totalDias >= 7 Then
laborables = totalDias
sabados = semanas
domingos = semanas
End If
If dias = 6 Then
If numDia = 2 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 5 Then
If numDia = 2 Then
sabados = sabados
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
ElseIf numDia = 3 Then
sabados = sabados + 1
domingos = domingos
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 4 Then
If numDia = 2 Or numDia = 3 Then
sabados = sabados
domingos = domingos
ElseIf numDia = 4 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados + 1
domingos = domingos + 1
End If
End If
If dias = 3 Then
If numDia = 6 Or numDia = 7 Then
sabados = sabados + 1
domingos = domingos + 1
ElseIf numDia = 5 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
If dias = 2 Then
If numDia = 7 Then
sabados = sabados + 1
domingos = domingos + 1
ElseIf numDia = 6 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
If dias = 1 Then
If numDia = 7 Then
sabados = sabados + 1
domingos = domingos
ElseIf numDia = 1 Then
sabados = sabados
domingos = domingos + 1
Else
sabados = sabados
domingos = domingos
End If
End If
noLaborables = sabados + domingos
laborables = totalDias - noLaborables
Label1 = CStr(totalDias) & " días naturales."
Label2 = CStr(semanas) & " semanas y " & dias & " días."
Label3 = CStr(laborables) & " días laborables."
Label4 = CStr(sabados) & " sábados."
Label5 = CStr(domingos) & " domingos."
End Sub

tecniCam
18 de Julio del 2004
Se que lo habeis descargado unos 30...
Al menos podríais, alguno, dar las gracias o decir si os ha gustado o alguna cosa, ¿no?

mesna
18 de Julio del 2004
Por que no lo pusiste en la seccion de codigos?

tecniCam
18 de Julio del 2004
TAMBIÉN ESTÁ EN LA SECCIÓN DE CÓDIGOS

semperfimxl
18 de Julio del 2004
A tu resultado, sin haberlo probado realmente, le falta un dia en el rango de dias naturales que arroja...
La funcion datediff te estra regresando los dias transcurridos desde la fecha inicial hasta la fecha final, pero a dichos dias transcurridos le falta sumar 1...
Ademas, no estas utilizando entonces la funcion Laborables en tu rutina? Veo que repites todo el codigo de nuevo en al command1_click() ...


Toda la funcion a base if's que tienes puedes resumirla de la siguiente manera (entre mas corto el codigo, mejor se entiende... digo yo...)

Private Function CalculaDias(FechaI As Date, FechaF As Date) As Variant

' Esta funcion retornara un arreglo de 6 posiciones (0-5) con los siguientes resultados...
' Posiciones Del Arreglo....
' 0=Dias Naturales
' 1=Semanas Completas
' 2=Dias Adicionales a las semanas completas
' 3=Dias Laborables (Lunes a Viernes)
' 4=Sabados
' 5=Domingos

Dim aResultado(5) As Variant

Dim dFecha As Date

aResultado(0) = DateDiff("d", FechaI, FechaF) + 1
aResultado(1) = Int(aResultado(0) / 7)
aResultado(2) = aResultado(0) - (aResultado(1) * 7)

For dFecha = FechaI To FechaF
If Weekday(dFecha) = 7 Then ' Sabado
aResultado(4) = aResultado(4) + 1
ElseIf Weekday(dFecha) = 1 Then ' Domingo
aResultado(5) = aResultado(5) + 1
End If
Next dFecha

aResultado(3) = aResultado(0) - (aResultado(4) + aResultado(5))

CalculaDias = aResultado

End Function



Private Sub Command1_Click()
Dim aResultado As Variant
Dim nCount As Integer

aResultado = CalculaDias(desde, hasta)

Label1 = aResultado(0) & " días naturales."
Label2 = aResultado(1) & " semanas y " & aResultado(2) & " días."
Label3 = aResultado(3) & " días laborables."
Label4 = aResultado(4) & " sábados."
Label5 = aResultado(5) & " domingos."

For nCount = 0 To 5
txtResultado(nCount) = aResultado(nCount)
Next

End Sub

semperfimxl
18 de Julio del 2004
>>>>>>>
For nCount = 0 To 5
txtResultado(nCount) = aResultado(nCount)
Next
<<<<<<<

Quiten esta parte del codigo del command1_click...
Es lo que yo utilize para presentar los resultados y se me paso eliminarla al momento de postear el codigo...