Dias corridos entre datas em VBA
Function DiasCorridosEntreDatas(DataInicial As Date, DataFinal As Date) As Long
DiasCorridosEntreDatas = (DataFinal - DataInicial)
End Function
Dias úteis entre datas em VBA
Function DiasUteisEntreDatas(DataInicial As Date, DataFinal As Date) As Double
Dim Idatas As Date
Dim i As Double
i = 0
For Idatas = DataInicial To DataFinal
If ÉDiaUtil(Idatas) Then i = i + 1
Next
DiasUteisEntreDatas = i
End Function
Dias corridos após dias úteis em VBA
Function DiasCorridosAposDiasUteis(Data As Date, DiasUteis As Long) As Long
DiasCorridosAposDiasUteis = DiasCorridosEntreDatas(Data, DataAposDiasUteis(Data, DiasUteis))
End Function
Dias úteis após dias corridos em VBA
Function DiasUteisAposDiasCorridos(Data As Date, DiasCorridos As Long) As Long
DiasUteisAposDiasCorridos = DiasUteisEntreDatas(Data, Data + DiasCorridos)
End Function
Data após dias corridos em VBA
Function DataAposDiasCorridos(Data As Date, dias As Long) As String
DataAposDiasCorridos = Data + dias
End Function
Data após dias úteis em VBA
Function DataAposDiasUteis(Data As Date, dias As Long)
Dim i As Long
Dim DataUtil As Date
i = 0
DataUtil = Data
Do While Abs(i) < Abs(dias)
If ÉDiaUtil(DataUtil) Then i = i + Sgn(dias)
DataUtil = DataUtil + Sgn(dias)
Loop
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + Sgn(dias + 0.5)
Loop
DataAposDiasUteis = DataUtil
End Function
Próximo dia Útil em VBA
Function ProximoDiaUtil(Data As Date) As Date
Dim DataUtil As Date
DataUtil = Data + 1
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + 1
Loop
ProximoDiaUtil = DataUtil
End Function
Primeiro dia útil do mês em VBA
Function PrimeiroDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMes As Date
PrimeiroDiaMes = CDate("01/" & Str(Month(Data)) & Str(Year(Data)))
PrimeiroDiaUtilMes = IIf(ÉDiaUtil(PrimeiroDiaMes), _
PrimeiroDiaMes, ProximoDiaUtil(PrimeiroDiaMes))
End Function
Ultimo dia útil do mês em VBA
Function UltimoDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMesSeguinte As Date
If Month(Data) < 12 Then
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/" _
& Str(Month(Data) + 1) & Str(Year(Data))))
Else
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/01" _
& Str(Year(Data) + 1)))
End If
UltimoDiaUtilMes = DataAposDiasUteis(PrimeiroDiaMesSeguinte, -1)
End Function
Função para saber se é fim de semana em VBA
Function ÉFimSemana(Data As Date) As Boolean
If WeekDay(Data, vbMonday) < 6 Then
ÉFimSemana = False
Else
ÉFimSemana = True
End If
End Function
Função para saber se é Sábado em VBA
Function ÉSábado(Data As Date) As Boolean
If WeekDay(Data) = 7 Then
ÉSábado = True
Else
ÉSábado = False
End If
End Function
Função para saber se é Domingo em VBA
Function ÉDomingo(Data As Date) As Boolean
If WeekDay(Data) = 1 Then
ÉDomingo = True
Else
ÉDomingo = False
End If
End Function
Função em VBA para saber se é dia útil
Function ÉDiaUtil(Data As Date) As Boolean
If Not ÉFeriado(Data) And Not ÉFimSemana(Data) And Not ÉPascoa(CDate(Data)) Then
ÉDiaUtil = True
Else
ÉDiaUtil = False
End If
End Function
Função em VBA para saber qual o dia da semana
Function DiaDaSemana(Data As Date) As String
Select Case WeekDay(Data, vbMonday)
Case 1
DiaDaSemana = "Segunda"
Case 2
DiaDaSemana = "Terça"
Case 3
DiaDaSemana = "Quarta"
Case 4
DiaDaSemana = "Quinta"
Case 5
DiaDaSemana = "Sexta"
Case 6
DiaDaSemana = "Sábado"
Case 7
DiaDaSemana = "Domingo"
End Select
End Function
Função em VBA para saber o nome do mês
Function NomedoMes(iMesAtual As Integer)
Dim sNomeMes As String
Select Case iMesAtual
Case 1
sNomeMes = "Janeiro"
Case 2
sNomeMes = "Fevereiro"
Case 3
sNomeMes = "Março"
Case 4
sNomeMes = "Abril"
Case 5
sNomeMes = "Maio"
Case 6
sNomeMes = "Junho"
Case 7
sNomeMes = "Julho"
Case 8
sNomeMes = "Agosto"
Case 9
sNomeMes = "Setembro"
Case 10
sNomeMes = "Outubro"
Case 11
sNomeMes = "Novembro"
Case 12
sNomeMes = "Dezembro"
End Select
NomedoMes = sNomeMes
End Function
Função em VBA para determinar os feriados, muito útil.
Function ÉFeriado(sbsDia) As Boolean
Dim kcont As Integer, stFer(8) As String
stFer(1) = "1/1"
stFer(2) = "21/4"
stFer(3) = "1/5"
stFer(4) = "7/9"
stFer(5) = "12/10"
stFer(6) = "2/11"
stFer(7) = "15/11"
stFer(8) = "25/12"
For kcont = 1 To 8
If Day(sbsDia) & "/" & Month(sbsDia) = stFer(kcont) Then
ÉFeriado = True
Exit Function
End If
Next kcont
End Function
Função em VBA para saber se é Pascoa
Function ÉPascoa(sbsPascoa As Single) As Boolean
Dim sn As Integer, sa, sb, sc, sd, se, sf, sg, sh, si, sk, sl, sm, sp, sq As Single
Dim sDia, sMes, sDiaCarnaval, sDiaCarn, sMesCarnaval As Single
Dim stDiadePascoa As String, sDiadePascoa As Single, sDiaCorpChr As Single
sn = Year(sbsPascoa)
sa = sn - Int(sn / 19) * 19
sb = Int(sn / 100)
sc = sn - sb * 100
sd = Int(sb / 4)
se = sb - sd * 4
sf = Int((sb + 8) / 25)
sg = Int((sb - sf + 1) / 3)
sh = (19 * sa + sb - sd - sg + 15) - Int((19 * sa + sb - sd - sg + 15) / 30) * 30
si = Int(sc / 4)
sk = sc - si * 4
sl = (32 + 2 * se + 2 * si - sh - sk) - Int((32 + 2 * se + 2 * si - sh - sk) / 7) * 7
sm = Int((sa + 11 * sh + 22 * sl) / 451)
sp = Int((sh + sl - 7 * sm + 114) / 31)
sq = sh + sl - 7 * sm + 114 - sp * 31
sDia = sq + 1 'Domingo de Páscoa
sMes = sp 'Mês da Páscoa
stDiadePascoa = sDia & "/" & sMes & "/" & sn
sDiadePascoa = Int(CDate(stDiadePascoa))
sDiaCarnaval = sDiadePascoa - 47
sDiaCarn = sDiadePascoa - 48
sDiaCorpChr = sDiadePascoa + 60
If Day(sbsPascoa) = sDia And Month(sbsPascoa) = sp Then
ÉPascoa = True
End If
If Day(sbsPascoa) = sDia - 2 And Month(sbsPascoa) = sp Then
ÉPascoa = True
'Paixão de Cristo
End If
If Day(sbsPascoa) = Day(sDiaCarnaval) And Month(sbsPascoa) = Month(sDiaCarnaval) Then
ÉPascoa = True
'Terça Feira de Carnaval
End If
If Day(sbsPascoa) = Day(sDiaCorpChr) And Month(sbsPascoa) = Month(sDiaCorpChr) Then
ÉPascoa = True
'Corpus Christi
End If
If Day(sbsPascoa) = Day(sDiaCarn) And Month(sbsPascoa) = Month(sDiaCarn) Then
ÉPascoa = True
'Segunda feira de Carnaval
End If
End Function
Função para saber que idade a pessoa tem em VBA
Function QueIdade(dn)
QueIdade = Int((Date - dn) / 365.25)
QueIdade = IIf(QueIdade < 1, Format(QueIdade, "# anos"), Format(QueIdade, "# anos"))
End Function
Nenhum comentário:
Postar um comentário