Cálculo de data para férias

[programadorvb6]

Olá boa tarde.

Estou a tentar fazer uma rotina que me indique a data limite em que um colaborador pode gozar férias, com base na indicação dos dias atribuidos.

Nota : Este cálculo também acenta em Feriados e Fins de semana.

Para cáculo de Feriados usei este módulo (Aqui já apresentado)

odule Calculo_Feriados
    'Dias Feriados
    Public Function DiaFeriado(ByVal Data As Date) As Boolean
        Dim Dia As Integer = Data.Day
        Dim Mes As Integer = Data.Month
        Dim Ano As Integer = Data.Year

        'Festas moveis
        If Data.Date = Carnaval(Ano).Date Then Return True '"Entrudo/Carnaval"
        If Data.Date = SextaFeiraSanta(Ano).Date Then Return True ' "Sexta-Feira Santa"
        If Data.Date = Pascoa(Ano).Date Then Return True '"Páscoa"
        If Data.Date = CorpoDeDeus(Ano).Date Then Return True '"Corpo de Deus"

        'Feriados e dias Santos Fixos
        If Dia = 1 And Mes = 1 Then Return True '"Ano Novo"
        If Dia = 25 And Mes = 4 Then Return True '"Dia da Liberdade"
        If Dia = 1 And Mes = 5 Then Return True '"Dia do Trabalhador"
        If Dia = 10 And Mes = 6 Then Return True '"Dia de Portugal"
        If Dia = 15 And Mes = 8 Then Return True '"Assunção de Maria"
        If Dia = 5 And Mes = 10 Then Return True '"Implantação da República"
        If Dia = 1 And Mes = 11 Then Return True '"Todos os Santos"
        If Dia = 1 And Mes = 12 Then Return True '"Restauração da Independência"
        If Dia = 8 And Mes = 12 Then Return True '"Imaculada Conceição"
        If Dia = 25 And Mes = 12 Then Return True '"Natal"

        'Feriados Locais
        'If Dia = 1 And Mes = 7 Then Return "R" '"Feriado Regional(Madeira)"
        'If Dia = 21 And Mes = 8 Then Return "M" '"Feriado Municipal(Funchal)"
        'etc...

        Return False '"Dia Util"
    End Function

    'Festas Moveis
    Public Function Carnaval(ByVal Ano As Integer) As Date
        Dim D As Date = Pascoa(Ano)
        Return DateSerial(Ano, D.Month, D.Day - 47)
    End Function

    Public Function SextaFeiraSanta(ByVal Ano As Integer) As Date
        Dim D As Date = Pascoa(Ano)
        Return DateSerial(Ano, D.Month, D.Day - 2)
    End Function

    Public Function Pascoa(ByVal Ano As Integer) As Date

        Dim A As Integer = Ano Mod 19
        Dim B As Integer = Int(Ano / 100)
        Dim C As Integer = Ano Mod 100
        Dim D As Integer = Int(B / 4)
        Dim E As Integer = B Mod 4
        Dim F As Integer = Int((B + 8) / 25)
        Dim G As Integer = Int((B - F + 1) / 3)
        Dim H As Integer = (19 * A + B - D - G + 15) Mod 30
        Dim I As Integer = Int(C / 4)
        Dim J As Integer = C Mod 4
        Dim L As Integer = (32 + 2 * E + 2 * I - H - J) Mod 7
        Dim M As Integer = Int((A + 11 + H + 22 * L) / 451)

        Dim Mes As Integer = Int((H + L - 7 * M + 114) / 31)
        Dim Dia As Integer = 1 + ((H + L - 7 * M + 114) Mod 31)

        Return DateSerial(Ano, Mes, Dia)
    End Function

    Public Function CorpoDeDeus(ByVal Ano As Integer) As Date
        Dim D As Date = Pascoa(Ano)
        Return DateSerial(Ano, D.Month, D.Day + 60)
    End Function

End Module

No form coloquei :

Public Class Form1
    
    Private Function AdicionaTempo(pDataInicial As DateTime, pDias As Integer) As DateTime
        Dim resultado As DateTime = pDataInicial


        While pDias > -1
                 'Se é sábado=2 (ando dois dias para a frente), domingo ou feriado=1 (ando um dia para frente)
           If resultado.DayOfWeek = DayOfWeek.Saturday Then
                resultado = resultado.AddDays(2)
            ElseIf resultado.DayOfWeek = DayOfWeek.Sunday Then
                resultado = resultado.AddDays(1)
            ElseIf DiaFeriado(resultado).Equals(True) And Not resultado.DayOfWeek = DayOfWeek.Saturday Or resultado.DayOfWeek = DayOfWeek.Sunday Then
                resultado = resultado.AddDays(1)
                'Ou se quiser adicionar um dia útil (X horas trabalhadas = 1 dia útil)
            ElseIf pDias > 0 Then
                resultado = resultado.AddDays(1)
                pDias -= 1
                'Se a data final for no fim de semana ou feriado
            ElseIf pDias = 0 Then
                While resultado.DayOfWeek = DayOfWeek.Saturday OrElse resultado.DayOfWeek = DayOfWeek.Sunday OrElse DiaFeriado(resultado).Equals(True)
                    'Se é sábado=2 (ando dois dias para a frente), domingo ou feriado=1 (ando um dia para frente)
                    If resultado.DayOfWeek = DayOfWeek.Saturday Then
                        resultado = resultado.AddDays(2)
                    ElseIf resultado.DayOfWeek = DayOfWeek.Sunday Then
                        resultado = resultado.AddDays(1)
                    ElseIf DiaFeriado(resultado).Equals(True) And Not resultado.DayOfWeek = DayOfWeek.Saturday Or resultado.DayOfWeek = DayOfWeek.Sunday Then
                        resultado = resultado.AddDays(1)
                    End If
                End While
                pDias = -1
            End If
        End While
        Return resultado
    End Function
    '=================================================================================================
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MsgBox(AdicionaTempo("30/11/2012", 18)) '+18 
    End Sub

End Class

Não me devolve a data correcta.

Grato desde já pela vossa atenção.

Atenciosamente.

Programadorvb6

[José Lopes]

Eu uso estas duas e funciona....para determinar se é ou não feriado... quanto ao resto é adaptares....

 

  Public Function IsHolliday(ByVal dt As Date) As Boolean
        On Error GoTo xError
        Const cteProcedure As String = "IsHolliday"

        Dim dia As Integer
        Dim Mes As Integer
        Dim Ano As Integer
        Dim diaPascoa As Integer
        Dim mesPascoa As Integer

        dia = (dt.Day)
        Mes = Month(dt)
        Ano = Year(dt)

        If Mes = 1 And dia = 1 Then
            IsHolliday = True ' ano novo
        ElseIf Mes = 4 And dia = 25 Then
            IsHolliday = True ' dia da liberdade
        ElseIf Mes = 5 And dia = 1 Then
            IsHolliday = True ' dia do trabalhador
        ElseIf Mes = 6 And dia = 10 Then
            IsHolliday = True
        ElseIf Mes = 6 And dia = 13 Then
            IsHolliday = True ' feriado municipal
        ElseIf Mes = 8 And dia = 15 Then
            IsHolliday = True
        ElseIf Mes = 10 And dia = 5 Then
            IsHolliday = True
        ElseIf Mes = 11 And dia = 1 Then
            IsHolliday = True ' dia de todos os santos
        ElseIf Mes = 12 And dia = 1 Then
            IsHolliday = True
        ElseIf Mes = 12 And dia = 8 Then
            IsHolliday = True
        ElseIf Mes = 12 And dia = 25 Then
            IsHolliday = True ' natal
        End If
        If IsHolliday Then
            Exit Function
        Else
            IsHolliday_Easter(diaPascoa, mesPascoa, Ano)
            If DateSerial(Ano, Mes, dia) = DateSerial(Ano, mesPascoa, diaPascoa) Then
                IsHolliday = True ' dia de páscoa
            ElseIf DateSerial(Ano, Mes, dia) = DateAdd(DateInterval.Day, -47, DateSerial(Ano, mesPascoa, diaPascoa)) Then
                IsHolliday = True ' carnaval
            ElseIf DateSerial(Ano, Mes, dia) = DateAdd(DateInterval.Day, -2, DateSerial(Ano, mesPascoa, diaPascoa)) Then
                IsHolliday = True ' sexta-feira santa
            ElseIf DateSerial(Ano, Mes, dia) = DateAdd(DateInterval.Day, 60, DateSerial(Ano, mesPascoa, diaPascoa)) Then
                IsHolliday = True ' Corpo de Deus
            End If
        End If
xExit:
        Exit Function
xError:
        Select Case Err()
            Case Else
                ShowError(Err.Number, Err.Description, cteModule, cteProcedure)
        End Select
        Resume xExit
    End Function

 

 ' procedure: IsHolliday_Easter
    ' purpose..: procedimento de apoio á função IsHolliday para cálculo do dia de Páscoa
    ' param1...: d - dia
    ' param2...: m - mês
    ' param3...: y - ano
    ' observ1..: os parâmetros são actualizados com o dia e o mês da Páscoa
    

    Private Sub IsHolliday_Easter(ByRef d, ByRef m, ByRef y)
        On Error GoTo xError
        Const cteProcedure As String = "IsHolliday_Easter"

        Dim a, b, c As Integer
        Dim tA, tB, tC, tD, tE As Integer

        a = y \ 100
        b = y Mod 19
        c = (a - 15) \ 2 + (a > 26) + (a > 38) + 202 - 11 * b
        c = c + ((a = 21) Or (a = 24) Or (a = 25) Or (a = 33) Or (a = 36) Or (a = 37))
        c = c Mod 30
        tA = c + (c = 29) + (c = 28 And b > 10) + 21
        tB = (tA - 19) Mod 7
        c = (40 - a) Mod 4
        tC = c - (c > 1) - (c = 3)
        c = y Mod 100
        tD = (c + c \ 4) Mod 7
        tE = ((20 - tB - tC - tD) Mod 7) + 1
        d = tA + tE
        If d > 31 Then
            d = d - 31
            m = 4
        Else
            m = 3
        End If

xExit:
        Exit Sub
xError:
        Select Case Err()
            Case Else
                ShowError(Err.Number, Err.Description, cteModule, cteProcedure)
        End Select
        Resume xExit
    End Sub

[programadorvb6]

Caro José Lopes.

No Form fiz assim :

Public Class Form1
    Public Function Total_Dias(Data_Inicial As Date, Data_Final As Date) As Integer

        Dim Calculo_TimeSpan As TimeSpan
        Dim Numero_de_dias As Integer = 0
        Dim Conta_Fims_de_Semana As Integer = 0
        Dim Conta_Feriados As Integer = 0
        Dim Faz_Soma_Total As String
        Dim watch As Stopwatch = Stopwatch.StartNew()

        'Calcula o periodo de dias entre uma data a outra.
        Calculo_TimeSpan = Data_Final.Subtract(Data_Inicial)
        'Variável que retém esse periodo de nº de dias
        Numero_de_dias = Calculo_TimeSpan.Days

        watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
        For i As Integer = 1 To Numero_de_dias ' Ciclo que percorre o inicio da data indicada até ao seu término.

            Data_Inicial = Data_Inicial.AddDays(1) 'Incrementa (1) dia ao anterior.
            'Conta apenas Fims de semana.
            If Data_Inicial.DayOfWeek = DayOfWeek.Sunday Or Data_Inicial.DayOfWeek = DayOfWeek.Saturday Then
                Conta_Fims_de_Semana += 1
            End If
            'Conta apenas Feriados, com a condição de não se enquadrarem em Fims de semana.
            If Data_Inicial.DayOfWeek <> DayOfWeek.Sunday AndAlso Data_Inicial.DayOfWeek <> DayOfWeek.Saturday Then
                If DiaFeriado(Data_Inicial).Equals(True) Then
                    Conta_Feriados += 1
                End If
            End If

        Next
        'Termina a contagem de execução  do ciclo (Fim Teste)
        watch.Stop()
        'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.
        MsgBox("Tempo que demorou o ciclo a ser executado : " & watch.Elapsed.TotalSeconds & " Seg.")


        'Faz o cálculo, Subtraindo ao Total_de_dias;  o nº total de Fims de semana + Feriados. 
        Faz_Soma_Total = Val(Numero_de_dias + 1) - Val(Conta_Fims_de_Semana + Conta_Feriados)

        Return Faz_Soma_Total 'Total_Dias
    End Function
    '=================================================================================================
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MsgBox("Total de dias => [ 01/01/1900 ] até [ 01/01/2013 ] = " & Total_Dias(CDate("01/01/1900"), CDate("01/01/2013")))
    End Sub
End Class

Mas isto é só para 1 empregado, acontece que eu tenho que fazer o cálculo para cerca de +- 200 empregados  que o cliente tem a seu cargo em poucos segundos,  sendo  as férias repartidas ao longo do ano.

Resumindo : A função  terá que  ser  bastante rápida ,  talvez limpando um pouco + o código .

Alguma solução?

Grato desde já pela sua atenção e colaboração.

Atentamente.

Programadorvb6

[José Lopes]

Compreendo o teu ponto de vista, não conheço os mecanismos que estás a utilizar...para marcares as férias todas, a todos os colaboradores, mas imagino que não seja uma coisa que faças todos os dias...

Neste contexto, tens que avaliar se os tempos de execução são ou não aceitáveis. Francamente não me parece que isto demore por aí além.. apesar de ser complexa, são funções de comparação básica, não implica consultas a base de dados nem nada, por isso parece-me possível.. e a questão do pouco tempo é relativa... eu por exemplo estou a falar de 4000 pessoas coisa menos coisa... é claro que isto é calculado fulado a fulano (por causa dos vários períodos de previsão - em termos de mapa de férias). mas é instantâneo... dou duas datas e nem fico à espera...

De qualquer modo, o que eu tenho é:

Dado Intervalo de Datas ele devolve o número de dias úteis:

 

 Function getDiasUteisFerias(ByVal dtInicio, ByVal dtTermo) As Integer
        Dim dtCiclo As Date
        Dim intDiaSemana As Integer
        Try
            getDiasUteisFerias = 0
            dtCiclo = dtInicio
            'For dtCiclo = dtInicio To dtTermo
            Do Until dtCiclo = DateAdd(DateInterval.Day, 1, dtTermo)
                intDiaSemana = dtCiclo.DayOfWeek
                'intDiaSemana = CInt(Format(dtCiclo, "d"))
                If IsHolliday(dtCiclo) Then
                    intDiaSemana = 8
                End If
                If intDiaSemana > 0 And intDiaSemana < 6 Then
                    getDiasUteisFerias = getDiasUteisFerias + 1
                End If
                dtCiclo = DateAdd(DateInterval.Day, 1, dtCiclo)
            Loop
            'Next
        Catch ex As Exception

        End Try

    End Function

Esta função serve-se das duas anteriores...

Já agora, não sei que SGBD estás a usar...mas se isto é feito em lote, parece-me ser um trabalho para ser feito em diferido pela Base de Dados, com recurso a um job ou qualquer coisa do género...

[programadorvb6]

Olá José Lopes.

Quero desde já agradecer pela sua colaboração e paciência.

O exemplo que vou postar aqui, levou-me a repensar um pouco na minha rotina derivado á descrepância de valores (um pouco estranho) do nº de dias atribuidos no 1º ensaio.

http://img822.imageshack.us/img822/4961/teste1g.jpg

Fiz assim utilizando (por enquanto) o meu módulo para dias Feriados.

Public Class Form1
    Public Function Total_Dias(ByVal Data_Inicial As DateTime, ByVal Data_Final As DateTime) As Integer

        Dim Calculo_TimeSpan As TimeSpan
        Dim Numero_de_dias As Integer = 0
        Dim Conta_Fims_de_Semana As Integer = 0
        Dim Conta_Feriados As Integer = 0
        Dim Faz_Soma_Total As String
        Dim watch As Stopwatch = Stopwatch.StartNew()

        'Calcula o periodo de dias entre uma data a outra.
        Calculo_TimeSpan = Data_Final.Subtract(Data_Inicial)
        'Variável que retém esse periodo de nº de dias
        Numero_de_dias = Calculo_TimeSpan.Days

        watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
        For i As Integer = 1 To Numero_de_dias ' Ciclo que percorre o inicio da data indicada até ao seu término.

            Data_Inicial = Data_Inicial.AddDays(1) 'Incrementa (1) dia ao anterior.
            'Conta apenas Fims de semana.
            If Data_Inicial.DayOfWeek = DayOfWeek.Sunday Or Data_Inicial.DayOfWeek = DayOfWeek.Saturday Then
                Conta_Fims_de_Semana += 1
            End If
            'Conta apenas Feriados, com a condição de não se enquadrarem em Fims de semana.
            If Data_Inicial.DayOfWeek <> DayOfWeek.Sunday AndAlso Data_Inicial.DayOfWeek <> DayOfWeek.Saturday Then
                If DiaFeriado(Data_Inicial).Equals(True) Then
                    Conta_Feriados += 1
                End If
            End If

        Next
        'Termina a contagem de execução  do ciclo (Fim Teste)
        watch.Stop()
        Me.Quadro.Items.Add("Tempo [ Rotina Antiga ] => " & watch.Elapsed.TotalSeconds & " Seg.")
        'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.
        ' MsgBox("Tempo que demorou o ciclo a ser executado : " & watch.Elapsed.TotalSeconds & " Seg.")


        'Faz o cálculo, Subtraindo ao Total_de_dias;  o nº total de Fims de semana + Feriados. 
        Faz_Soma_Total = Val(Numero_de_dias + 1) - Val(Conta_Fims_de_Semana + Conta_Feriados)

        Return Faz_Soma_Total 'Total_Dias
        Refresh()
       
    End Function

    Public Function getDiasUteisFerias(ByVal dtInicio, ByVal dtTermo) As Integer
       Dim dtCiclo As Date
        Dim total As UInteger = 0
        Dim intDiaSemana As Integer
        Dim watch As Stopwatch = Stopwatch.StartNew()
        Try
            watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
            getDiasUteisFerias = 0
            dtCiclo = dtInicio
            'For dtCiclo = dtInicio To dtTermo
            Do Until dtCiclo = DateAdd(DateInterval.Day, 1, dtTermo)
                intDiaSemana = dtCiclo.DayOfWeek

                If DiaFeriado(dtCiclo).Equals(True) Then
                    intDiaSemana = 8 ' Marca como sendo feriado, para que não seja contado

                End If
                If intDiaSemana > 0 And intDiaSemana < 6 Then
                    getDiasUteisFerias += 1
                End If
                dtCiclo = DateAdd(DateInterval.Day, 1, dtCiclo)
            Loop
            'Next
            'Termina a contagem de execução  do ciclo (Fim Teste)
            watch.Stop()
            'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.
            Me.Quadro.Items.Add("Tempo [ Rotina Nova ] => " & watch.Elapsed.TotalSeconds & " Seg.")
            ' MsgBox("Tempo que demorou o ciclo a ser executado : " & watch.Elapsed.TotalSeconds & " Seg.")

            total = getDiasUteisFerias

        Catch ex As Exception


        Finally
        End Try
        Return total

    End Function

    '=================================================================================================
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MsgBox("Total de dias => [ 01/01/1900 ] até [ 01/01/2013 ] Nova = " & getDiasUteisFerias(CDate("01/01/1900"), CDate("01/01/2013")))
        MsgBox("Total de dias => [ 01/01/1900 ] até [ 01/01/2013 ] Antiga  = " & Total_Dias(CDate("01/01/1900"), CDate("01/01/2013")))
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        MsgBox("Total de dias => [ 02/04/2012 ] até [ 27/04/2012 ] Nova = " & getDiasUteisFerias(CDate("02/04/2012"), CDate("27/04/2012")))
        MsgBox("Total de dias => [ 02/04/2012 ] até [ 27/04/2012 ] Antiga = " & Total_Dias(CDate("02/04/2012"), CDate("27/04/2012")))

    End Sub
End Class

- Deixo aqui o link para download : http://www.box.com/s/8ce14df34ae07f3062ec

Devo ter algum erro na minha rotina que ainda não descobri.

Grato desde já pela sua ajuda

Programadorvb6

[José Lopes]

Efectivamente a tua é mais rápida....tanto que se calhar a vou passar a usar....ehehehe

o teu erro deve estar nesta linha:

   'Faz o cálculo, Subtraindo ao Total_de_dias;  o nº total de Fims de semana + Feriados. 
        Faz_Soma_Total = Val(Numero_de_dias + 1) - Val(Conta_Fims_de_Semana + Conta_Feriados)

Para que estás a somar um dia ao número de dias????

[programadorvb6]

Olá José Lopes.

Eu vou optar pela sua LOL!

Tentar modifica-la para que seja + rápida.

Repare neste pequena análise para ano Bissexto.

Public Function Total_Dias(ByVal Data_Inicial As DateTime, ByVal Data_Final As DateTime) As Integer

        Dim Calculo_TimeSpan As TimeSpan
        Dim Numero_de_dias As Integer = 0
        Dim Conta_Fims_de_Semana As Integer = 0
        Dim Conta_Feriados As Integer = 0

        Dim watch As Stopwatch = Stopwatch.StartNew()
        watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
        'Calcula o periodo de dias entre uma data a outra.
        Calculo_TimeSpan = Data_Final.Subtract(Data_Inicial)
        'Variável que retém esse periodo de nº de dias
        Numero_de_dias = Calculo_TimeSpan.Days

        'Faz o cálculo, Subtraindo ao Total_de_dias;  o nº total de Fims de semana + Feriados. 

        Me.Quadro.Items.Add("Tempo [ Rotina Antiga ] => " & watch.Elapsed.TotalSeconds & " Seg.")
        Return Numero_de_dias 'Total_Dias

        watch.Stop()
        'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.

        Refresh()
       
    End Function

    Public Function getDiasUteisFerias(ByVal dtInicio, ByVal dtTermo) As Integer
       Dim dtCiclo As Date
        Dim total As UInteger = 0

        Dim watch As Stopwatch = Stopwatch.StartNew()
        Try
            watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
            getDiasUteisFerias = 0
            dtCiclo = dtInicio
            'For dtCiclo = dtInicio To dtTermo
            Do Until dtCiclo = DateAdd(DateInterval.Day, 1, dtTermo)

                getDiasUteisFerias += 1

                dtCiclo = DateAdd(DateInterval.Day, 1, dtCiclo)
            Loop
            'Next
            'Termina a contagem de execução  do ciclo (Fim Teste)
            watch.Stop()
            'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.
            Me.Quadro.Items.Add("Tempo [ Rotina Nova ] => " & watch.Elapsed.TotalSeconds & " Seg.")
            ' MsgBox("Tempo que demorou o ciclo a ser executado : " & watch.Elapsed.TotalSeconds & " Seg.")

            total = getDiasUteisFerias

        Catch ex As Exception


        Finally
        End Try
        Return total
        Refresh()
    End Function

    '=================================================================================================
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MsgBox("Total de dias => [ 01/01/1900 ] até [ 01/01/2013 ] Nova = " & getDiasUteisFerias(CDate("01/01/1900"), CDate("01/01/2013")))
        MsgBox("Total de dias => [ 01/01/1900 ] até [ 01/01/2013 ] Antiga  = " & Total_Dias(CDate("01/01/1900"), CDate("01/01/2013")))
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
       
        MsgBox("Total de dias => [ 01/01/2012 ] até [ 31/12/2012 ](Bissexto) Nova = " & getDiasUteisFerias(CDate("01/01/2012"), CDate("31/12/2012")))
        MsgBox("Total de dias => [ 01/01/2012 ] até [ 31/12/2012 ] (Bissexto) Antiga = " & Total_Dias(CDate("01/01/2012"), CDate("31/12/2012")))

    End Sub

Grato desde já pela sua atenção.

Atentamente

Programadorvb6

[José Lopes]

Isso quer então dizer que o teu não está a contar o ano bissexto??

[programadorvb6]

Olá José lopes.

Analise esta função :

 ''' <summary>
    ''' Devolve a diferença em dias de duas datas. 
    ''' </summary>
    Function SubtraiData(ByVal Data1 As Date, ByVal Data2 As Date) As String
        Dim Total As TimeSpan = Data1.Subtract(Data2) '<== Como tenho na minha rotina
        Return CStr(Math.Abs(Total.Days))
    End Function

A função não analisa se é ano Bissexto, simplesmente devolve a diferença de dias.

[José Lopes]

    ''' <summary>
    ''' Devolve a diferença em dias de duas datas. 
    ''' </summary>
    Function SubtraiData(ByVal Data1 As Date, ByVal Data2 As Date) As String
        Dim i As Integer
        Dim Total As TimeSpan = Data1.Subtract(Data2) '<== Como tenho na minha rotina
        MsgBox(CStr(Math.Abs(Total.Days)))
        Do Until Data1 = DateAdd(DateInterval.Day, 1, Data2)
            i += 1
            Data1 = DateAdd(DateInterval.Day, 1, Data1)
        Loop
        MsgBox(i)
    End Function

alterei um pouco a função que faz estas contas para contabilizar ambos os métodos, e a verdade é que continua a dar diferença de um dia... o que só pode ter uma explicação...

Tu estás a efectuar uma diferença e não a contar, logo provavelmente perde-se um dia nos cálculos...

Se não for isso.... não sei....

[programadorvb6]

Olá novamente José Lopes.

Desde já quero agradecer a tua colaboração e muita paciência.

De facto é um erro imperdoável LOL!

Mas acho que consegui! (Acho eu, porque também já não sei +..)

Bem, começando : como dizes e muito bem, pretendo fazer uma adição e não uma subtracção, daí a função que me passas-te estar correcta.

Na minha função, fiz algumas alterações, uma delas foi a variável [Numero_de_dias ] que recebe directamente o valor :  Numero_de_dias = Conta_Dias(Data_Inicial, Data_Final)

Posteriormente  vi que o incremento efectuado aos nº dias estava mal colocado [  Data_Inicial = Data_Inicial.AddDays(1) ] , o que fazia com que o primeiro 'varrimento' de verificação fosse nulo ( não acontecia ).

Assim fiz assim:

Public Class Form1
    ''' <summary>
    ''' Função que devolve quantos dias o trabalhador tem de Férias (Usando o método : For i As Integer).
    ''' </summary>
    Public Function Total_Dias(ByVal Data_Inicial As DateTime, ByVal Data_Final As DateTime) As Integer

        Dim Numero_de_dias As Integer = 0
        Dim Conta_Fims_de_Semana As Integer = 0
        Dim Conta_Feriados As Integer = 0
        Dim Faz_Soma_Total As String
        Dim watch As Stopwatch = Stopwatch.StartNew()


        watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
        Numero_de_dias = Conta_Dias(Data_Inicial, Data_Final)
        For i As Integer = 1 To Numero_de_dias ' Ciclo que percorre o inicio da data indicada até ao seu término.

            'Conta apenas Fims de semana.
            If Data_Inicial.DayOfWeek = DayOfWeek.Sunday Or Data_Inicial.DayOfWeek = DayOfWeek.Saturday Then
                Conta_Fims_de_Semana += 1
            End If
            'Conta apenas Feriados, com a condição de não se enquadrarem em Fims de semana.
            If Data_Inicial.DayOfWeek <> DayOfWeek.Sunday AndAlso Data_Inicial.DayOfWeek <> DayOfWeek.Saturday Then
                If DiaFeriado(Data_Inicial).Equals(True) Then
                    Conta_Feriados += 1
                End If
            End If
            Data_Inicial = Data_Inicial.AddDays(1) 'Incrementa (1) dia ao anterior.
        Next
        'Termina a contagem de execução  do ciclo (Fim Teste)
        watch.Stop()
        Me.Quadro.Items.Add("Tempo [ Rotina Antiga ] => " & watch.Elapsed.TotalSeconds & " Seg.")

        'Faz o cálculo, Subtraindo ao Total_de_dias;  o nº total de Fims de semana + Feriados. 
        Faz_Soma_Total = Val(Numero_de_dias) - Val(Conta_Fims_de_Semana + Conta_Feriados)

        Return Faz_Soma_Total 'Total_Dias
        Refresh()

    End Function

    ''' <summary>
    ''' Função que devolve quantos dias o trabalhador tem de Férias (Usando o método :  Do Until).
    ''' </summary>

    Public Function Dias_Uteis_Ferias(ByVal Data_Inicial, ByVal Data_Final) As Integer
        Dim Apontador_Ciclo As Date
        Dim total As UInteger = 0
        Dim intDiaSemana As Integer
        Dim watch As Stopwatch = Stopwatch.StartNew()
        Try
            watch.Start() ' (Teste) começa a contar o tempo de execução do ciclo
            Dias_Uteis_Ferias = 0
            Apontador_Ciclo = Data_Inicial
            Do Until Apontador_Ciclo = DateAdd(DateInterval.Day, 1, Data_Final)
                intDiaSemana = Apontador_Ciclo.DayOfWeek

                If DiaFeriado(Apontador_Ciclo).Equals(True) Then
                    intDiaSemana = 8 ' Marca como sendo feriado, para que não seja contado

                End If
                If intDiaSemana > 0 And intDiaSemana < 6 Then
                    Dias_Uteis_Ferias += 1
                End If
                Apontador_Ciclo = DateAdd(DateInterval.Day, 1, Apontador_Ciclo)
            Loop

            'Termina a contagem de execução  do ciclo (Fim Teste)
            watch.Stop()
            'Informa  o tempo que demorou o ciclo a ser executado, para uma possível optimização de código.
            Me.Quadro.Items.Add("Tempo [ Rotina Nova ] =>  " & watch.Elapsed.TotalSeconds & " Seg.")
            ' MsgBox("Tempo que demorou o ciclo a ser executado : " & watch.Elapsed.TotalSeconds & " Seg.")

            total = Dias_Uteis_Ferias

        Catch ex As Exception


        Finally
        End Try
        Return total

    End Function
    '=================================================================================================
    
    ''' <summary>
    ''' Devolve o total em dias entre  duas datas. 
    ''' </summary>
    Public Function Conta_Dias(ByVal Data1 As Date, ByVal Data2 As Date) As UInteger
        Dim Incrementa As Integer
        Do Until Data1 = DateAdd(DateInterval.Day, 1, Data2)
            incrementa += 1
            Data1 = DateAdd(DateInterval.Day, 1, Data1)
        Loop
        Return Incrementa
    End Function
    '=================================================================================================
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MsgBox("Total de dias => [ " & FormatDateTime(Me.DateTimePicker1.Value.ToString, DateFormat.ShortDate) & " ] até [ " & FormatDateTime(Me.DateTimePicker2.Value.ToString, DateFormat.ShortDate) & " ] (Nova)= " & Dias_Uteis_Ferias(CDate(Me.DateTimePicker1.Value), CDate(Me.DateTimePicker2.Value)))

        MsgBox("Total de dias => [ " & FormatDateTime(Me.DateTimePicker1.Value.ToString, DateFormat.ShortDate) & " ] até [ " & FormatDateTime(Me.DateTimePicker2.Value.ToString, DateFormat.ShortDate) & " ] (Antiga)  = " & Total_Dias(CDate(Me.DateTimePicker1.Value), CDate(Me.DateTimePicker2.Value)))
    End Sub
End Class

Link para Download : http://www.box.com/s/6b3bbd1bfaca2f368745

Grato desde já pela sua disponibilidade em me ajudar.

Atentamente

Programadorvb6

[José Lopes]

Soa-me bem e a diferença de tempos baixou substancialmente...

Prontos... parece que o problema está mesmo resolvido ;-)

PS - ele às vezes fica imenso tempo a correr a primeira rotina. e acaba por estourar aqui:

Public Function Conta_Dias(ByVal Data1 As Date, ByVal Data2 As Date) As UInteger
        Dim Incrementa As Integer
        Do Until Data1 = DateAdd(DateInterval.Day, 1, Data2)
            incrementa += 1
            Data1 = DateAdd(DateInterval.Day, 1, Data1)
        Loop
        Return Incrementa
    End Function

experimenta por exemplo manter as datas que aparecem à cabeça...

[programadorvb6]

Olá José Lopes.

Qual o programa de diagnóstico que está a usar ?

O Pex?

[José Lopes]

Mesmo em modo debug no VS (2008). eu importei os teus objectos...

[programadorvb6]

Olá José Lopes.

Troque por este código e poste se surgiu algum erro : stack overflow.

   ''' <summary>
    ''' Devolve o total em dias entre  duas datas. 
    ''' </summary>

    Public Function Conta_Dias(ByVal Data1 As Date, ByVal Data2 As Date) As Int64
        Dim Incrementa As Int64
        Dim Data_I As Date = Format(Data1, "d")
        Dim Data_F As Date = Format(Data2, "d")
        Do Until Data_I = DateAdd(DateInterval.Day, 1, Data_F)
            Incrementa += 1
            Data_I = DateAdd(DateInterval.Day, 1, Data_I)
        Loop
        Return Incrementa
        Refresh()
    End Function

Já agora veja , para ter uma ideia, quanto tempo demoram as rotinas a executar este cálculo.

    
'=================================================================================================
  Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Refresh()

        MsgBox("Total de dias => [ " & Format(Me.DateTimePicker1.Value, "d") & " ] até [ " & Format(Me.DateTimePicker2.Value, "d") & " ] (Nova)= " & Dias_Uteis_Ferias(CDate(Format(Me.DateTimePicker1.Value, "d")), CDate(Format(Me.DateTimePicker2.Value, "d"))))
        MsgBox("Total de dias => [ " & Format(Me.DateTimePicker1.Value, "d") & " ] até [ " & Format(Me.DateTimePicker2.Value, "d") & " ] (Antiga)  = " & Total_Dias(CDate(Me.DateTimePicker1.Value), CDate(Me.DateTimePicker2.Value)))

        MsgBox("Total de dias => [ " & Format(Me.DateTimePicker1.Value, "d") & " ] até [ " & Format(Me.DateTimePicker2.Value, "d") & " ] (Nova)= " & Dias_Uteis_Ferias(CDate("01/01/1900"), CDate("30/12/9999")))
        MsgBox("Total de dias => [ " & Format(Me.DateTimePicker1.Value, "d") & " ] até [ " & Format(Me.DateTimePicker2.Value, "d") & " ] (Antiga)  =  " & Total_Dias(CDate("01/01/1900"), CDate("30/12/9999")))
    End Sub

Grato desde já pela sua atenção e colaboração.

Atentamente

programadorvb6

[José Lopes]

Continua a trocar-se todo...

http://dl.dropbox.com/u/749895/1.PNG

http://dl.dropbox.com/u/749895/2.PNG

Vê lá o valor de dias retornado sem ter mexido nas datas....

[programadorvb6]

Olá José Lopes.

Veja agora se já está em conformidade.

Link : http://www.box.com/s/34840c17f4eb563cc67c

Grato desde já pela sua atenção e paciência.

Atentamente.

Programadorvb6