¿Quién quiere este código? CONTAR DIFERENCIA DÍAS LABORABLES Y FESTIVOS
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
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
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?
Al menos podríais, alguno, dar las gracias o decir si os ha gustado o alguna cosa, ¿no?
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
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