MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    avatar
    zcarloslopes
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 161
    Registrado : 28/10/2010

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  zcarloslopes em 16/4/2019, 14:37

    Boa tarde,

    Venho novamente pedir a vossa ajuda.

    Preciso calcular dias úteis entre datas (excluindo fds e feriados) sem recurso a tabela.

    A ideia seria colocar num Form os feriados Nacionais e Regionais com uma checkbox para cada, e no cálculo seria verificado que feriados são para considerar de acordo com as checkboxs.

    Procurei aqui no forum e encontrei no tópico: http://www.maximoaccess.com/t1051-resolvidoscalcular-dias-uteis-entre-datas?highlight=%C3%BAteis

    uma referência a: esnips.com/doc/d382c80b-2fa6-49e6-bffb-66068edcc5cb/DiasUteis , mas infelizmente o link não está mais funcionando.

    Alguém pode ajudar por favor?

    Obrigado


    Última edição por zcarloslopes em 23/4/2019, 14:19, editado 1 vez(es)
    avatar
    wjfe48
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 20
    Registrado : 03/09/2016

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  wjfe48 em 17/4/2019, 17:51

    Oi.

    Creio que seria difícil tendo em vista que há feriados nacionais, estaduais e municipais.

    Mas você poderia desenvolver uma função para desconsiderar, dentro do intervalo desejado, sábados e domingos e lendo a tabela para os feriados, saber o nº de dias úteis.

    Há uma função dentro do VBA que retorna o nº do dia: Weekday (data)... Se = 1 será domingo 7 será sábado.

    Ao menos, é isso que eu uso.

    Waldemar
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10558
    Registrado : 04/11/2009

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  JPaulo em 18/4/2019, 09:28

    Olá;

    Sem recurso a tabela será extremamente dificil, porque o forumulario desvinculado não guarda dados, por isso nem as checkboxes irão funcionar.

    Download



    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Instruções SQL como utilizar...
    avatar
    zcarloslopes
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 161
    Registrado : 28/10/2010

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  zcarloslopes em 18/4/2019, 14:27

    Obrigado pelo retorno,

    Possível é, até porque já consegui, no entanto o código fica demasiado lento.

    O formulário é vinculado, é um formulário de manutenção que atualiza campos que podem mudar (nome do chefe, categoria, etc), estes campos irão servir principalmente para manter os relatório atializados, então eu lembrei que poderia fazer o mesmo com os feriados que estão sempre a mudar de acordo com "birras de criança" dos políticos, mas ao invés de ter uma tabela com os feriados, que implica ter que carregar todos os anos, teria apenas uma checkbox que num determinado periodo e/ou localidade pode considerar o feriado ou não.

    A ideia seria passar os feriados numa array, e desconsiderar os mesmos na contagem dos dias úteis como acontece com os sábados e domingos.

    Segue os exemplos que estou a tentar:

    Exemplo que funciona, mas muito lento:
    Código:
    Public Function WorkdayDiffHoly(ByVal d1 As Date, ByVal d2 As Date) As Long
      Dim diff As Long, sign As Long
      Dim wd1 As Integer, wd2 As Integer
      
      Dim AnoNovo As Integer '01/01
      Dim DiaLiberdade As Integer '25/04
      Dim DiaTrabalhador As Integer '01/05
      Dim DiaPortugal As Integer '10/06
      Dim StoAntonio As Integer '13/6
      Dim SaoJoao As Integer '24/06
      Dim NossaSenhora As Integer '15/08
      Dim Republica As Integer '05/10
      Dim TodosSantos As Integer '01/11
      Dim Independencia As Integer '01/12
      Dim Imaculada As Integer '08/12
      Dim Natal As Integer '25/12
      Dim Carnaval As Integer 'Móvel
      Dim SextaSanta As Integer 'Móvel
      Dim Pascoa As Integer 'Móvel
      Dim CorpoDeus As Integer 'Móvel
      Dim SraMatosinhos As Integer 'Móvel
      
      
    'USAGE:
    'WorkdayDiffHoly(field1, field2)

      diff = DateDiff("d", d1, d2)
      If diff < 0 Then
        '* Effectively swap d1 and d2; reverse sign
        diff = -diff
        sign = -1
        wd1 = Weekday(d2)
      Else
        sign = 1
        wd1 = Weekday(d1)
      End If
      wd2 = (wd1 + diff - 1) Mod 7 + 1

      If (wd1 = 1 And diff = 0) Or (wd1 = 7 And diff <= 1) Then
        WorkdayDiffHoly = 0 '* Both dates are on same weekend
        Exit Function
      End If

      '* If starting or ending date fall on weekend, shift to closest weekday
      '* since the weekends should not contribute to the sum.
      '* This shift is critical for the last If condition and arithmetic.
      If wd1 = 1 Then
        wd1 = 2 '* Shift to Monday
        diff = diff - 1
      ElseIf wd1 = 7 Then
        wd1 = 2 '* Shift to Monday
        diff = diff - 2
      End If

      If wd2 = 1 Then
        diff = diff - 2 '* Shift to Friday
      ElseIf wd2 = 7 Then
        diff = diff - 1 '* Shift to Friday
      End If

      '* If difference goes beyond weekend boundary then...
      If diff >= 7 - wd1 Then
        '* Normalize span to start on Monday for modulus arithmetic
        '* then remove weekend days
        diff = diff - ((diff + (wd1 - 2)) \ 7) * 2
      End If
      
      'Ano Novo (1 de Janeiro) - Fixo
      If (((DateSerial(year(d1), 1, 1)) >= d1 And (DateSerial(year(d1), 1, 1)) <= d2 And _
      Weekday(DateSerial(year(d1), 1, 1)) <> 7 And Weekday(DateSerial(year(d1), 1, 1)) <> 1) And _
      DLookup("chkAnoNovo", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      AnoNovo = 1
      Else
      AnoNovo = 0
      End If

      
      'Dia da Liberdade (25 de Abril) - Fixo
      If (((DateSerial(year(d1), 4, 25)) >= d1 And (DateSerial(year(d1), 4, 25)) <= d2 And _
      Weekday(DateSerial(year(d1), 4, 25)) <> 7 And Weekday(DateSerial(year(d1), 4, 25)) <> 1) And _
      DLookup("chkDiaLiberdade", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      DiaLiberdade = 1
      Else
      DiaLiberdade = 0
      End If
        
      'Dia do Trabalhador (1 de Maio) - Fixo
      If (((DateSerial(year(d1), 5, 1)) >= d1 And (DateSerial(year(d1), 5, 1)) <= d2 And _
      Weekday(DateSerial(year(d1), 5, 1)) <> 7 And Weekday(DateSerial(year(d1), 5, 1)) <> 1) And _
      DLookup("chkDiaTrabalhador", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      DiaTrabalhador = 1
      Else
      DiaTrabalhador = 0
      End If
      
      'Dia do Portugal (10 de Junho) - Fixo
      If (((DateSerial(year(d1), 6, 10)) >= d1 And (DateSerial(year(d1), 6, 10)) <= d2 And _
      Weekday(DateSerial(year(d1), 6, 10)) <> 7 And Weekday(DateSerial(year(d1), 6, 10)) <> 1) And _
      DLookup("chkDiaPortugal", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      DiaPortugal = 1
      Else
      DiaPortugal = 0
      End If
      
      'Santo António (13 de Junho) - Fixo
      If (((DateSerial(year(d1), 6, 13)) >= d1 And (DateSerial(year(d1), 6, 13)) <= d2 And _
      Weekday(DateSerial(year(d1), 6, 13)) <> 7 And Weekday(DateSerial(year(d1), 6, 13)) <> 1) And _
      DLookup("chkSantoAntonio", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      StoAntonio = 1
      Else
      StoAntonio = 0
      End If
      
      'São João (24 de Junho) - Fixo
      If (((DateSerial(year(d1), 6, 24)) >= d1 And (DateSerial(year(d1), 6, 24)) <= d2 And _
      Weekday(DateSerial(year(d1), 6, 24)) <> 7 And Weekday(DateSerial(year(d1), 6, 24)) <> 1) And _
      DLookup("chkSaoJoao", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      SaoJoao = 1
      Else
      SaoJoao = 0
      End If
      
      'Assunção de Nossa Senhora (15 de Agosto) - Fixo
      If (((DateSerial(year(d1), 8, 15)) >= d1 And (DateSerial(year(d1), 8, 15)) <= d2 And _
      Weekday(DateSerial(year(d1), 8, 15)) <> 7 And Weekday(DateSerial(year(d1), 8, 15)) <> 1) And _
      DLookup("chkNossaSenhora", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      NossaSenhora = 1
      Else
      NossaSenhora = 0
      End If
      
      'Implantação da República (5 de Outubro) - Fixo
      If (((DateSerial(year(d1), 10, 5)) >= d1 And (DateSerial(year(d1), 10, 5)) <= d2 And _
      Weekday(DateSerial(year(d1), 10, 5)) <> 7 And Weekday(DateSerial(year(d1), 10, 5)) <> 1) And _
      DLookup("chkImplRepublica", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Republica = 1
      Else
      Republica = 0
      End If
      
      'Dia de Todos os Santos (1 de Novembro) - Fixo
      If (((DateSerial(year(d1), 11, 1)) >= d1 And (DateSerial(year(d1), 11, 1)) <= d2 And _
      Weekday(DateSerial(year(d1), 11, 1)) <> 7 And Weekday(DateSerial(year(d1), 11, 1)) <> 1) And _
      DLookup("chkTodosSantos", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      TodosSantos = 1
      Else
      TodosSantos = 0
      End If
      
      'Restauração da Independência (1 de Dezembro) - Fixo
      If (((DateSerial(year(d1), 12, 1)) >= d1 And (DateSerial(year(d1), 12, 1)) <= d2 And _
      Weekday(DateSerial(year(d1), 12, 1)) <> 7 And Weekday(DateSerial(year(d1), 12, 1)) <> 1) And _
      DLookup("chkIndependencia", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Independencia = 1
      Else
      Independencia = 0
      End If
      
      'Dia da Imaculada Conceição (8 de Dezembro) - Fixo
      If (((DateSerial(year(d1), 12, 8)) >= d1 And (DateSerial(year(d1), 12, 8)) <= d2 And _
      Weekday(DateSerial(year(d1), 12, 8)) <> 7 And Weekday(DateSerial(year(d1), 12, 8)) <> 1) And _
      DLookup("chkImaculada", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Imaculada = 1
      Else
      Imaculada = 0
      End If
      
      'Natal (25 de Dezembro) - Fixo
      If (((DateSerial(year(d1), 12, 25)) >= d1 And (DateSerial(year(d1), 12, 25)) <= d2 And _
      Weekday(DateSerial(year(d1), 12, 25)) <> 7 And Weekday(DateSerial(year(d1), 12, 25)) <> 1) And _
      DLookup("chkNatal", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Natal = 1
      Else
      Natal = 0
      End If
      
      'Carnaval (Páscoa - 47) - Móvel
      If (((EasterDate2(year(d1)) - 47) >= d1 And (EasterDate2(year(d1)) - 47) <= d2 And _
      (EasterDate2(year(d1)) - 47) <> (DateSerial(year(d1), 4, 25))) And _
      DLookup("chkCarnaval", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Carnaval = 1 'Nuca é ao domingo
      Else
      Carnaval = 0
      End If
      
      'Sexta-Feira Santa (Páscoa - 2) - Móvel
      If (((EasterDate2(year(d1)) - 2) >= d1 And (EasterDate2(year(d1)) - 2) <= d2 And _
      (EasterDate2(year(d1)) - 2) <> (DateSerial(year(d1), 4, 25))) And _
      DLookup("chkSextaSanta", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      SextaSanta = 1 'Nuca é ao domingo
      Else
      SextaSanta = 0
      End If
      
      'Páscoa - Móvel
      If (((EasterDate2(year(d1))) >= d1 And (EasterDate2(year(d1))) <= d2) And _
      DLookup("chkPascoa", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      Pascoa = 0 'Páscoa é sempre ao domingo
      Else
      Pascoa = 0
      End If
      
      'Corpo de Deus (Páscoa + 60) - Móvel
      If (((EasterDate2(year(d1)) + 60) >= d1 And (EasterDate2(year(d1)) + 60) <= d2 And _
      (EasterDate2(year(d1)) + 60) <> (DateSerial(year(d1), 4, 25)) And _
      (EasterDate2(year(d1)) + 60) <> (DateSerial(year(d1), 5, 1)) And _
      (EasterDate2(year(d1)) + 60) <> (DateSerial(year(d1), 6, 10))) And _
      DLookup("chkCorpoDeus", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      CorpoDeus = 1 'Nuca é ao domingo
      Else
      CorpoDeus = 0
      End If
      
      'Senhora de Matosinhos(Páscoa + 51) - Móvel
      If (((EasterDate2(year(d1)) + 51) >= d1 And (EasterDate2(year(d1)) + 51) <= d2 And _
      (EasterDate2(year(d1)) + 51) <> (DateSerial(year(d1), 4, 25)) And _
      (EasterDate2(year(d1)) + 51) <> (DateSerial(year(d1), 5, 1)) And _
      (EasterDate2(year(d1)) + 51) <> (DateSerial(year(d1), 6, 10))) And _
      DLookup("chkSenhoraMatosinhos", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1) Then
      SraMatosinhos = 1 'Nuca é ao domingo
      Else
      SraMatosinhos = 0
      End If
      

      WorkdayDiffHoly = (sign * (diff + 1)) - AnoNovo - DiaLiberdade - DiaTrabalhador - DiaPortugal - _
                                            NossaSenhora - Republica - TodosSantos - Independencia - SaoJoao - _
                                            Imaculada - Natal - Carnaval - SextaSanta - Pascoa - CorpoDeus - StoAntonio - SraMatosinhos
      
    End Function

    A função Páscoa de apoio ao código acima:
    Código:
    Option Compare Database

    Public Function EasterDate2(Yr As Integer) As Date
        Dim D As Integer
        D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
        EasterDate2 = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - ((Yr + Yr \ 4 + _
                D + (D > 48) + 1) Mod 7)
    End Function

    O que estou tentando é adaptar a array abaixo na primeira função, ou noutra que funcione:
    Código:
    Function isExclude(testDate As Date) As Boolean
    Dim excludeDates(1 To 17) As Date
    Dim intyear As Integer
    intyear = Format(testDate, "YYYY")
    Dim I As Integer
    'Lista de Feriados
    '''''''''''''''''''''''''''''''''''''''''''''
    excludeDates(1) = CDate("1/1/" & intyear) 'Ano Novo
    excludeDates(2) = CDate("4/25/" & intyear) 'Dia da Liberdade
    excludeDates(3) = CDate("5/1/" & intyear)  'Dia do Trabalhador
    excludeDates(4) = CDate("6/10/" & intyear)  'Dia de Portugal
    excludeDates(5) = CDate("6/13/" & intyear)  'Santo António
    excludeDates(6) = CDate("6/24/" & intyear) 'São João
    excludeDates(7) = CDate("8/15/" & intyear)  'Assunção de Nossa Senhora
    excludeDates(8) = CDate("10/5/" & intyear)  'Implantação da República
    excludeDates(9) = CDate("11/1/" & intyear)  'Todos os Santos
    excludeDates(10) = CDate("12/1/" & intyear)  'Restauração da Independência
    excludeDates(11) = CDate("12/8/" & intyear) 'Imaculada Conceição
    excludeDates(12) = CDate("12/25/" & intyear)  'Natal
                        
    'Feriados Móveis
    excludeDates(13) = dt_Pascoa ' Páscoa
    excludeDates(14) = dt_Carnaval 'Carnaval
    excludeDates(15) = dt_SextaSanta 'Sexta-feira Santa
    excludeDates(16) = dt_Matosinhos 'Senhora de Matosinhos
    excludeDates(17) = dt_CorpusC 'Corpo de Deus

    For I = 1 To 17
    If testDate = excludeDates(I) Then
    isExclude = True
    Exit Function
    End If
    Next I
    isExclude = False

    End Function

    Function isWeekend(testDate As Date) As Boolean
    Select Case Weekday(testDate)
    Case vbSaturday, vbSunday
    isWeekend = True
    Case Else
    isWeekend = False
    End Select
    End Function

    Public Function fncFeriadosMoveis(ano%) As String
    Dim dt_Pascoa As Date
    Dim dt_Carnaval As Date
    Dim dt_SextaSanta As Date
    Dim dt_CorpusC As Date
    Dim dt_Matosinhos As Date
    Dim A%, B%, C%, D%, E%, F%, G%, H%, I%, k%, L%, M%, P%, Q%
    A = (ano Mod 19)
    B = Int(ano / 100)
    C = (ano Mod 100)
    D = Int(B / 4)
    E = (B Mod 4)
    F = Int((B +  / 25)
    G = Int((B - F + 1) / 3)
    H = ((19 * A + B - D - G + 15) Mod 30)
    I = Int(C / 4): k = (C Mod 4)
    L = ((32 + 2 * E + 2 * I - H - k) Mod 7)
    M = Int((A + 11 * H + 22 * L) / 451)
    P = Int((H + L - 7 * M + 114) / 31)
    Q = ((H + L - 7 * M + 114) Mod 31)

    dt_Pascoa = CDate((Q + 1) & "/" & P & "/" & ano)
    dt_Carnaval = DateAdd("d", -47, dt_Pascoa)
    dt_SextaSanta = DateAdd("d", -2, dt_Pascoa)
    dt_Matosinhos = DateAdd("d", 51, dt_Pascoa)
    dt_CorpusC = DateAdd("d", 60, dt_Pascoa)

    End Function

    Nesta array falta ainda colocar a condição se a checkbox = -1 para cada feriado.

    Alguma ideia seria muito bem vinda.

    Obrigado
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10558
    Registrado : 04/11/2009

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  JPaulo em 18/4/2019, 15:28

    Quando eu lhe disse que não dava, era no sentido das checkboxes estarem num formulario de feriados sem tabela.
    Onde seria guardado o valor das checkboxes ????


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Instruções SQL como utilizar...
    avatar
    zcarloslopes
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 161
    Registrado : 28/10/2010

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  zcarloslopes em 18/4/2019, 16:16

    Obrigado pelo retorno,

    O valor das checkboxes, como no exemplo do código que funciona, embora lento, seria guardado na talela:

    tbl_SEFT_CamposRelatorios

    nos campos:

    chkAnoNovo
    chkDiaLiberdade
    chkDiaTrabalhado
    chkDiaPortugal
    chkSantoAntonio
    chkSaoJoao
    chkNossaSenhora
    chkImplRepublica
    chkTodosSantos
    chkIndependencia
    chkImaculada
    chkNatal
    chkPascoa
    chkSextaSanta
    chkCarnaval
    chkSenhoraMatosinhos
    chkCorpoDeus

    Obrigado mais uma vez
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10558
    Registrado : 04/11/2009

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  JPaulo em 18/4/2019, 16:17

    Mas o amigo disse varias vezes que não teria tabela e até no titulo do tópico está mencionado.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Folder_announce_new Instruções SQL como utilizar...
    avatar
    zcarloslopes
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 161
    Registrado : 28/10/2010

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  zcarloslopes em 18/4/2019, 16:32

    Peço desculpa por induzir em erro.

    O que prendia dizer é que as datas dos feriados não estão armazenadas em tabela, em vez disso, é apenas verificado se determinado feriado é considerado para a contagem dos dias úteis ou não.

    A ideia seria (salvo melhor opinião) colocar numa array os feriados verificados para considerar na contagem, em vez dos muitos ifs que coloquei no meu primeiro código que o torna muito lento.

    Obrigado.
    avatar
    zcarloslopes
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 161
    Registrado : 28/10/2010

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  zcarloslopes em 23/4/2019, 14:18

    Boa tarde a todos,

    Obrigado pelas tentativas de ajuda.

    Após muitas voltas e pesquisas consegui arranjar uma solução a partir de um código para cálculo de horas de trabalho (créditos para o autor) que adaptei para o meu propósito, deixando a opção para ser usado também no cálculo de horas.

    Funcionalidades:
    Calcula dias ou horas entre duas datas;
    Exclui fim de semana independentemente de calhar nos limites das datas ou não;
    Exclui feriados independentemente de calhar nos limites das datas ou não;
    Se o feriado coincidir com o fds, reajusta cálculo;
    Não carece de tabela para alojar as datas dos feriados (fixos e/ou móveis)
    No entanto, tem a opção de criar uma tabela com campos Sim/Não para poder considerar um feriado ou não;
    Caso data de início seja igual à data de fim, retorna 1 dia
    Caso data de início seja superior à data de fim, retorna 0 dias

    Obrigado

    Código:
    Public Function basWrkHrsOrDays(StDate As Date, EndDate As Date) As Double

        'Get the number of work HOURS between the given dates
        'Michael Red    8/23/01

        Dim blnHoliFnd As Boolean       'Flag for Hloiday found
        Dim Hollydate(16) As Date       'Table of Holidays
        Dim Idx As Long                 'Index for start/end dates
        Dim Kdx As Long                 'Index / counter for Number of days
        Dim Jdx As Integer              'Index doe the Hloidate array
        Dim MyDate As Date              'Tempdate
        Dim AccumTime As Double         'Hours Accumulated
        
        Dim intyear As Integer
        intyear = year(EndDate)

        Const MinsPerDay = 1440         'Every Minute of the DAY!!
        Const MinsPerHr = 60#           '60 Minutes per Hour

        'For MAINTENANCE purposes, the array should be in a TABLE
        'There SHOULD be a form to add/edit/delete the table.
        
        'At run time, the TABLE should be wholy loaded into the ARRAY
        'to promote execution effiency.

        'Array(Table) of Holiday Dates
        
        '-------------------------------------------------------------------------------------------------------------------------------------------------------
        'COM USO DE CHECKBOX
        '-------------------
        Hollydate(0) = IIf(DLookup("chkAnoNovo", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("01/01/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Ano Novo
        Hollydate(1) = IIf(DLookup("chkDiaLiberdade", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("04/25/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Dia da Liberdade
        Hollydate(2) = IIf(DLookup("chkDiaTrabalhador", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("05/01/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Dia do Trabalhador
        Hollydate(3) = IIf(DLookup("chkDiaPortugal", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("06/10/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Dia de Portugal
        Hollydate(4) = IIf(DLookup("chkSantoAntonio", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("06/13/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Santo António
        Hollydate(5) = IIf(DLookup("chkSaoJoao", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("06/24/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'São João
        Hollydate(6) = IIf(DLookup("chkNossaSenhora", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("08/15/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Assunção de Nossa Senhora
        Hollydate(7) = IIf(DLookup("chkImplRepublica", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("10/05/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Implantação da República
        Hollydate(8) = IIf(DLookup("chkTodosSantos", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("11/01/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Todos os Santos
        Hollydate(9) = IIf(DLookup("chkIndependencia", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("12/01/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Restauração da Independência
        Hollydate(10) = IIf(DLookup("chkImaculada", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("012/08/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Imaculada Conceição
        Hollydate(11) = IIf(DLookup("chkNatal", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, Format(("12/25/" & intyear), "mm/dd/yyyy"), #1/1/1900#) 'Natal
        
        'Feriados Móveis
        Hollydate(12) = IIf(DLookup("chkPascoa", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, (Pascoa(intyear)), #1/1/1900#)  ' Páscoa
        Hollydate(13) = IIf(DLookup("chkCarnaval", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, DateAdd("d", -47, (Pascoa(intyear))), #1/1/1900#) 'Carnaval
        Hollydate(14) = IIf(DLookup("chkSextaSanta", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, DateAdd("d", -2, (Pascoa(intyear))), #1/1/1900#) 'Sexta-feira Santa
        Hollydate(15) = IIf(DLookup("chkSenhoraMatosinhos", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, DateAdd("d", 51, (Pascoa(intyear))), #1/1/1900#) 'Senhora de Matosinhos
        Hollydate(16) = IIf(DLookup("chkCorpoDeus", "tbl_SEFT_CamposRelatorios", "ID = 1") = -1, DateAdd("d", 60, (Pascoa(intyear))), #1/1/1900#) 'Corpo de Deus
        '------------------------------------------------------------------------------------------------------------------------------------------------------
        '------------------------------------------------------------------------------------------------------------------------------------------------------
        'SEM USO DE CHECKBOX
        '-------------------
        'Hollydate(0) = Format(("01/01/" & intyear), "mm/dd/yyyy") 'Ano Novo
        'Hollydate(1) = Format(("04/25/" & intyear), "mm/dd/yyyy") 'Dia da Liberdade
        'Hollydate(2) = Format(("05/01/" & intyear), "mm/dd/yyyy") 'Dia do Trabalhador
        'Hollydate(3) = Format(("06/10/" & intyear), "mm/dd/yyyy") 'Dia de Portugal
        'Hollydate(4) = Format(("06/13/" & intyear), "mm/dd/yyyy") 'Santo António
        'Hollydate(5) = Format(("06/24/" & intyear), "mm/dd/yyyy") 'São João
        'Hollydate(6) = Format(("8/15/" & intyear), "mm/dd/yyyy") 'Assunção de Nossa Senhora
        'Hollydate(7) = Format(("10/05/" & intyear), "mm/dd/yyyy") 'Implantação da República
        'Hollydate(8) = Format(("11/01/" & intyear), "mm/dd/yyyy") 'Todos os Santos
        'Hollydate(9) = Format(("12/01/" & intyear), "mm/dd/yyyy") 'Restauração da Independência
        'Hollydate(10) = Format(("12/08/" & intyear), "mm/dd/yyyy") 'Imaculada Conceição
        'Hollydate(11) = Format(("12/25/" & intyear), "mm/dd/yyyy") 'Natal
        
        'Feriados Móveis
        'Hollydate(12) = (Pascoa(intyear))  ' Páscoa
        'Hollydate(13) = DateAdd("d", -47, (Pascoa(intyear))) 'Carnaval
        'Hollydate(14) = DateAdd("d", -2, (Pascoa(intyear))) 'Sexta-feira Santa
        'Hollydate(15) = DateAdd("d", 51, (Pascoa(intyear))) 'Senhora de Matosinhos
        'Hollydate(16) = DateAdd("d", 60, (Pascoa(intyear))) 'Corpo de Deus
        '---------------------------------------------------------------------------------


        'Get the incremental Minutes for the Start & End Dates
        If (Not (Weekday(StDate) = vbSaturday Or Weekday(StDate) = vbSunday)) Then
            'AccumTime = DateDiff("n", StDate, Format(StDate + 1, "mm/dd/yy")) 'PARA CÁLCULO DE HORAS
            AccumTime = DateDiff("n", StDate, Format(StDate, "mm/dd/yyyy"))    'PARA CÁLCULO DE DIAS
        End If

        If (Not (Weekday(EndDate) = vbSaturday Or Weekday(EndDate) = Sunday)) Then
            AccumTime = AccumTime + DateDiff("n", Format(EndDate, "mm/dd/yyyy"), EndDate)
        End If

        'MyDate = Format(StDate + 1, "Short Date")  'PARA CÁLCULO DE HORAS
        MyDate = Format(StDate, "Short Date")       'PARA CÁLCULO DE DIAS

        'Loop for each day INSIDE the interval
        'For Idx = CLng(StDate + 1) To CLng(EndDate) - 1    'PARA CÁLCULO DE HORAS
        For Idx = CLng(StDate) To CLng(EndDate)             'PARA CÁLCULO DE DIAS

            blnHoliFnd = False

            If (Weekday(MyDate) = vbSaturday Or Weekday(MyDate) = vbSunday) Then
                blnHoliFnd = True
                GoTo NoTime
            End If

            For Jdx = 0 To UBound(Hollydate)

                If (Hollydate(Jdx) = MyDate) Then
                    blnHoliFnd = True
                    Exit For
    '             Else
    '                Do Nothing, it is NOT a Workday
                End If

            Next Jdx

    NoTime:

            'count WHOLE (Work) days
            If (blnHoliFnd = False) Then
                Kdx = Kdx + 1
            End If
        
            MyDate = DateAdd("d", 1, MyDate)
            

        Next Idx

        'Got the number of days.  Now, add work minutes to acuumtime
        AccumTime = AccumTime + CSng(Kdx) * CSng(MinsPerDay)

        'basWrkHrsOrDays = AccumTime / MinsPerHr    'PARA CÁLCULO DE HORAS
        basWrkHrsOrDays = CSng(Kdx)                 'PARA CÁLCULO DE DIAS
      

    End Function

    Public Function Pascoa(Yr As Integer) As Date
        Dim D As Integer
        D = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
        Pascoa = DateSerial(Yr, 3, 1) + D + (D > 48) + 6 - ((Yr + Yr \ 4 + _
                D + (D > 48) + 1) Mod 7)
    End Function

    Conteúdo patrocinado

    [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela Empty Re: [Resolvido]Cálculo de Dias Úteis sem FDS e Feriados sem recurso a Tabela

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 18/7/2019, 16:46