Olá amigos,
Recentemente o nosso amigo Alexandre me ajudou num caso.
Queria calcular os dias úteis entre duas data, excluindo os finais de seman e os feriados nacionais e estaduais.
Agora o que estou precisando e que, com uma data eu informo a qtd de dias uteis e o access me retorna com uma data futura (excluindo finais de semana e feriados nacionais e estaduais).
Posto abaixo o código do Alexandre, pois acredito que ajudará muita gente.
Acredito também que com isso fique mais fácil resolver este meu problema atual (data futura).
Segue o código do mestre Alexandre.
Option Compare Database
Option Explicit
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
Enum NomeEstado
PAC = 1
PAL = 2
PAP = 3
PAM = 4
PBA = 5
PCE = 6
PDF = 7
PES = 8
PGO = 9
PMA = 10
Pmt = 11
PMS = 12
PMG = 13
PPA = 14
PPB = 15
PPR = 16
PPE = 17
PPI = 18
PRJ = 19
PRN = 20
PRS = 21
PRO = 22
PRR = 23
PSC = 24
PSP = 25
PSE = 26
PTO = 27
End Enum
Function DiasUteisBrasileiros(DataInicial As Date, DataFinal As Date, Optional Estado As NomeEstado) As Integer
Dim DataAtual As Date
DiasUteisBrasileiros = 0
For DataAtual = DataInicial To DataFinal
If Not FeriadoBrasileiro(DataAtual, Estado) And Weekday(DataAtual) <> 1 And Weekday(DataAtual) <> 7 Then DiasUteisBrasileiros = DiasUteisBrasileiros + 1
Next
End Function
Function PascoaB(intAno As Integer) As Date
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
Dim X As Byte, y As Byte
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte
If intAno > 1581 And intAno < 1600 Then X = 22: y = 2
If intAno > 1599 And intAno < 1700 Then X = 22: y = 2
If intAno > 1699 And intAno < 1800 Then X = 23: y = 3
If intAno > 1799 And intAno < 1900 Then X = 23: y = 4
If intAno > 1899 And intAno < 2000 Then X = 24: y = 5
If intAno > 1999 And intAno < 2100 Then X = 24: y = 5
If intAno > 2099 And intAno < 2200 Then X = 24: y = 6
If intAno > 2199 And intAno < 2300 Then X = 25: y = 7
a = intAno Mod 19
b = intAno Mod 4
c = intAno Mod 7
d = ((20 * a) + X) Mod 30
e = ((2 * b) + (4 * c) + (6 * d) + y) Mod 7
If (d + e) < 10 Then
PascoaB = DateSerial(intAno, 3, d + e + 22)
Else
PascoaB = DateSerial(intAno, 4, d + e - 9)
End If
If PascoaB = DateSerial(intAno, 4, 26) Then PascoaB = DateAdd("d", -7, PascoaB)
If PascoaB = DateSerial(intAno, 4, 25) And d = 28 And a > 10 Then PascoaB = DateAdd("d", -7, PascoaB)
End Function
Function FeriadoBrasileiro(dtData As Date, Optional strNomeEstado As NomeEstado) As Boolean
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
FeriadoBrasileiro = False
Select Case Format(dtData, "dd-mm")
Case "01-01"
FeriadoBrasileiro = True
Case "21-04"
FeriadoBrasileiro = True
Case "01-05"
FeriadoBrasileiro = True
Case "07-09"
FeriadoBrasileiro = True
Case "12-10"
FeriadoBrasileiro = True
Case "02-11"
FeriadoBrasileiro = True
Case "15-11"
FeriadoBrasileiro = True
Case "25-12"
FeriadoBrasileiro = True
End Select
If dtData = DateAdd("d", -47, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", -2, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = PascoaB(Year(dtData)) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 49, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 56, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 60, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If Not IsMissing(strNomeEstado) Then
Select Case strNomeEstado
Case PAC
If Format(dtData, "dd-mm") = "15-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "06-08" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "17-11" Then FeriadoBrasileiro = True
Case PAL
If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "16-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PAP
If Format(dtData, "dd-mm") = "19-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PAM
If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
Case PBA
If Format(dtData, "dd-mm") = "28-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "02-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PDF
If Format(dtData, "dd-mm") = "21-04" Then FeriadoBrasileiro = True
Case PES
If Format(dtData, "dd-mm") = "23-05" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
Case PGO
If Format(dtData, "dd-mm") = "26-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
Case PMA
If Format(dtData, "dd-mm") = "28-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-12" Then FeriadoBrasileiro = True
Case Pmt
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PMS
If Format(dtData, "dd-mm") = "11-10" Then FeriadoBrasileiro = True
Case PPA
If Format(dtData, "dd-mm") = "15-08" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
Case PPB
If Format(dtData, "dd-mm") = "05-08" Then FeriadoBrasileiro = True
Case PPR
If Format(dtData, "dd-mm") = "08-09" Then FeriadoBrasileiro = True
Case PPE
If Format(dtData, "dd-mm") = "06-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
Case PPI
If Format(dtData, "dd-mm") = "13-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "19-10" Then FeriadoBrasileiro = True
Case PRJ
If Format(dtData, "dd-mm") = "21-01" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "23-04" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "18-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PRN
If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "03-10" Then FeriadoBrasileiro = True
Case PRS
If Format(dtData, "dd-mm") = "20-09" Then FeriadoBrasileiro = True
Case PRO
If Format(dtData, "dd-mm") = "04-01" Then FeriadoBrasileiro = True
Case PRR
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
Case PSC
If Format(dtData, "dd-mm") = "11-08" Then FeriadoBrasileiro = True
Case PSP
If Format(dtData, "dd-mm") = "09-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PSE
If Format(dtData, "dd-mm") = "08-07" Then FeriadoBrasileiro = True
Case PTO
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
End Select
End If
End Function
No meu caso teve uma adaptação pois não uso a abreviação do estado (duas letras) no meu caso tenho uma letra "P" na frente. Para resolver isso o Alexandre me passou este outro código. Ele converte a minha sigla para um número e este é que é usado na função acima.
Function Estado(strEstado As String) As NomeEstado
Select Case strEstado
Case "PAC"
Estado = 1
Case "PAL"
Estado = 2
Case "PAP"
Estado = 3
Case "PAM"
Estado = 4
Case "PBA"
Estado = 5
Case "PCE"
Estado = 6
Case "PDF"
Estado = 7
Case "PES"
Estado = 8
Case "PGO"
Estado = 9
Case "PMA"
Estado = 10
Case "PMT"
Estado = 11
Case "PMS"
Estado = 12
Case "PMG"
Estado = 13
Case "PPA"
Estado = 14
Case "PPB"
Estado = 15
Case "PPR"
Estado = 16
Case "PPE"
Estado = 17
Case "PPI"
Estado = 18
Case "PRJ"
Estado = 19
Case "PRN"
Estado = 20
Case "PRS"
Estado = 21
Case "PRO"
Estado = 22
Case "PRR"
Estado = 23
Case "PSC"
Estado = 24
Case "PSP"
Estado = 25
Case "PSE"
Estado = 26
Case "PTO"
Estado = 27
End Select
End Function
Peço a ajudar dos feras de plantão.
[]s
André Lindolfo
Recentemente o nosso amigo Alexandre me ajudou num caso.
Queria calcular os dias úteis entre duas data, excluindo os finais de seman e os feriados nacionais e estaduais.
Agora o que estou precisando e que, com uma data eu informo a qtd de dias uteis e o access me retorna com uma data futura (excluindo finais de semana e feriados nacionais e estaduais).
Posto abaixo o código do Alexandre, pois acredito que ajudará muita gente.
Acredito também que com isso fique mais fácil resolver este meu problema atual (data futura).
Segue o código do mestre Alexandre.
Option Compare Database
Option Explicit
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
Enum NomeEstado
PAC = 1
PAL = 2
PAP = 3
PAM = 4
PBA = 5
PCE = 6
PDF = 7
PES = 8
PGO = 9
PMA = 10
Pmt = 11
PMS = 12
PMG = 13
PPA = 14
PPB = 15
PPR = 16
PPE = 17
PPI = 18
PRJ = 19
PRN = 20
PRS = 21
PRO = 22
PRR = 23
PSC = 24
PSP = 25
PSE = 26
PTO = 27
End Enum
Function DiasUteisBrasileiros(DataInicial As Date, DataFinal As Date, Optional Estado As NomeEstado) As Integer
Dim DataAtual As Date
DiasUteisBrasileiros = 0
For DataAtual = DataInicial To DataFinal
If Not FeriadoBrasileiro(DataAtual, Estado) And Weekday(DataAtual) <> 1 And Weekday(DataAtual) <> 7 Then DiasUteisBrasileiros = DiasUteisBrasileiros + 1
Next
End Function
Function PascoaB(intAno As Integer) As Date
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
Dim X As Byte, y As Byte
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte
If intAno > 1581 And intAno < 1600 Then X = 22: y = 2
If intAno > 1599 And intAno < 1700 Then X = 22: y = 2
If intAno > 1699 And intAno < 1800 Then X = 23: y = 3
If intAno > 1799 And intAno < 1900 Then X = 23: y = 4
If intAno > 1899 And intAno < 2000 Then X = 24: y = 5
If intAno > 1999 And intAno < 2100 Then X = 24: y = 5
If intAno > 2099 And intAno < 2200 Then X = 24: y = 6
If intAno > 2199 And intAno < 2300 Then X = 25: y = 7
a = intAno Mod 19
b = intAno Mod 4
c = intAno Mod 7
d = ((20 * a) + X) Mod 30
e = ((2 * b) + (4 * c) + (6 * d) + y) Mod 7
If (d + e) < 10 Then
PascoaB = DateSerial(intAno, 3, d + e + 22)
Else
PascoaB = DateSerial(intAno, 4, d + e - 9)
End If
If PascoaB = DateSerial(intAno, 4, 26) Then PascoaB = DateAdd("d", -7, PascoaB)
If PascoaB = DateSerial(intAno, 4, 25) And d = 28 And a > 10 Then PascoaB = DateAdd("d", -7, PascoaB)
End Function
Function FeriadoBrasileiro(dtData As Date, Optional strNomeEstado As NomeEstado) As Boolean
' 'criada por Alexandre Neves
' 'www.esnips.com\web\AlexandreNeves
FeriadoBrasileiro = False
Select Case Format(dtData, "dd-mm")
Case "01-01"
FeriadoBrasileiro = True
Case "21-04"
FeriadoBrasileiro = True
Case "01-05"
FeriadoBrasileiro = True
Case "07-09"
FeriadoBrasileiro = True
Case "12-10"
FeriadoBrasileiro = True
Case "02-11"
FeriadoBrasileiro = True
Case "15-11"
FeriadoBrasileiro = True
Case "25-12"
FeriadoBrasileiro = True
End Select
If dtData = DateAdd("d", -47, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", -2, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = PascoaB(Year(dtData)) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 49, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 56, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If dtData = DateAdd("d", 60, PascoaB(Year(dtData))) Then FeriadoBrasileiro = True
If Not IsMissing(strNomeEstado) Then
Select Case strNomeEstado
Case PAC
If Format(dtData, "dd-mm") = "15-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "06-08" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "17-11" Then FeriadoBrasileiro = True
Case PAL
If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "16-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PAP
If Format(dtData, "dd-mm") = "19-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PAM
If Format(dtData, "dd-mm") = "05-09" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
Case PBA
If Format(dtData, "dd-mm") = "28-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "02-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PDF
If Format(dtData, "dd-mm") = "21-04" Then FeriadoBrasileiro = True
Case PES
If Format(dtData, "dd-mm") = "23-05" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
Case PGO
If Format(dtData, "dd-mm") = "26-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
Case PMA
If Format(dtData, "dd-mm") = "28-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-12" Then FeriadoBrasileiro = True
Case Pmt
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PMS
If Format(dtData, "dd-mm") = "11-10" Then FeriadoBrasileiro = True
Case PPA
If Format(dtData, "dd-mm") = "15-08" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "08-12" Then FeriadoBrasileiro = True
Case PPB
If Format(dtData, "dd-mm") = "05-08" Then FeriadoBrasileiro = True
Case PPR
If Format(dtData, "dd-mm") = "08-09" Then FeriadoBrasileiro = True
Case PPE
If Format(dtData, "dd-mm") = "06-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "24-06" Then FeriadoBrasileiro = True
Case PPI
If Format(dtData, "dd-mm") = "13-03" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "19-10" Then FeriadoBrasileiro = True
Case PRJ
If Format(dtData, "dd-mm") = "21-01" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "23-04" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "18-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "28-10" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PRN
If Format(dtData, "dd-mm") = "29-06" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "03-10" Then FeriadoBrasileiro = True
Case PRS
If Format(dtData, "dd-mm") = "20-09" Then FeriadoBrasileiro = True
Case PRO
If Format(dtData, "dd-mm") = "04-01" Then FeriadoBrasileiro = True
Case PRR
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
Case PSC
If Format(dtData, "dd-mm") = "11-08" Then FeriadoBrasileiro = True
Case PSP
If Format(dtData, "dd-mm") = "09-07" Then FeriadoBrasileiro = True
If Format(dtData, "dd-mm") = "20-11" Then FeriadoBrasileiro = True
Case PSE
If Format(dtData, "dd-mm") = "08-07" Then FeriadoBrasileiro = True
Case PTO
If Format(dtData, "dd-mm") = "05-10" Then FeriadoBrasileiro = True
End Select
End If
End Function
No meu caso teve uma adaptação pois não uso a abreviação do estado (duas letras) no meu caso tenho uma letra "P" na frente. Para resolver isso o Alexandre me passou este outro código. Ele converte a minha sigla para um número e este é que é usado na função acima.
Function Estado(strEstado As String) As NomeEstado
Select Case strEstado
Case "PAC"
Estado = 1
Case "PAL"
Estado = 2
Case "PAP"
Estado = 3
Case "PAM"
Estado = 4
Case "PBA"
Estado = 5
Case "PCE"
Estado = 6
Case "PDF"
Estado = 7
Case "PES"
Estado = 8
Case "PGO"
Estado = 9
Case "PMA"
Estado = 10
Case "PMT"
Estado = 11
Case "PMS"
Estado = 12
Case "PMG"
Estado = 13
Case "PPA"
Estado = 14
Case "PPB"
Estado = 15
Case "PPR"
Estado = 16
Case "PPE"
Estado = 17
Case "PPI"
Estado = 18
Case "PRJ"
Estado = 19
Case "PRN"
Estado = 20
Case "PRS"
Estado = 21
Case "PRO"
Estado = 22
Case "PRR"
Estado = 23
Case "PSC"
Estado = 24
Case "PSP"
Estado = 25
Case "PSE"
Estado = 26
Case "PTO"
Estado = 27
End Select
End Function
Peço a ajudar dos feras de plantão.
[]s
André Lindolfo