Alguém consegue tirar o final de semana dessse VBA?
ele conta dias úteis só os dias da semana, preciso que conte os finais de semana tbm.
Valeu!
segue VBA:
Function HoraUtilUtilizada(ByVal HoraInicioSLA As Date, ByVal HoraFimSLA As Date, _
ByVal DataInicioSolicitacao As Date, ByVal DataFimSolicitacao As Date, ByVal Feriados As Range) As Variant
Dim qtdHorasDia
Dim diaInicioSolicitacao
Dim horaInicioSolicitacao
Dim diaFimSolicitacao
Dim horaFimSolicitacao
Dim qtdHorasUtilizadas
qtdHorasDia = HoraFimSLA - HoraInicioSLA
diaInicioSolicitacao = DateSerial(Year(DataInicioSolicitacao), Month(DataInicioSolicitacao), Day(DataInicioSolicitacao))
horaInicioSolicitacao = TimeSerial(Hour(DataInicioSolicitacao), Minute(DataInicioSolicitacao), Second(DataInicioSolicitacao))
diaFimSolicitacao = DateSerial(Year(DataFimSolicitacao), Month(DataFimSolicitacao), Day(DataFimSolicitacao))
horaFimSolicitacao = TimeSerial(Hour(DataFimSolicitacao), Minute(DataFimSolicitacao), Second(DataFimSolicitacao))
If HoraInicioSLA <> 0 And _
HoraFimSLA <> 0 And _
DataInicioSolicitacao <> 0 And _
DataFimSolicitacao <> 0 Then
If HoraInicioSLA < HoraFimSLA Then
If DataInicioSolicitacao > DataFimSolicitacao Then
HoraUtilUtilizada = "ERR:IniSLA>FimSLA"
Else
'verifica se a hora de inicio de abertura é maior que a hora de inicio do sla
If horaInicioSolicitacao >= HoraFimSLA Then
DataInicioSolicitacao = DataInicioSolicitacao + 1
horaInicioSolicitacao = HoraInicioSLA
End If
If horaInicioSolicitacao < HoraInicioSLA Then
horaInicioSolicitacao = HoraInicioSLA
End If
While verificaFeriado(Feriados.Address(False, False, , True), DataInicioSolicitacao) = True
DataInicioSolicitacao = DataInicioSolicitacao + 1
horaInicioSolicitacao = HoraInicioSLA
Wend
diaInicioSolicitacao = DateSerial(Year(DataInicioSolicitacao), Month(DataInicioSolicitacao), Day(DataInicioSolicitacao))
If diaInicioSolicitacao + horaInicioSolicitacao > DataFimSolicitacao Then
HoraUtilUtilizada = "ERR:IniSLA>FimSLA"
Else
While diaInicioSolicitacao <= diaFimSolicitacao
If diaInicioSolicitacao = diaFimSolicitacao Then
qtdHorasUtilizadas = qtdHorasUtilizadas + (horaFimSolicitacao - horaInicioSolicitacao)
Else
qtdHorasUtilizadas = qtdHorasUtilizadas + (HoraFimSLA - horaInicioSolicitacao)
horaInicioSolicitacao = HoraInicioSLA
End If
diaInicioSolicitacao = diaInicioSolicitacao + 1
If diaInicioSolicitacao <= diaFimSolicitacao Then
While verificaFeriado(Feriados.Address(False, False, , True), diaInicioSolicitacao) = True
diaInicioSolicitacao = diaInicioSolicitacao + 1
Wend
End If
Wend
HoraUtilUtilizada = qtdHorasUtilizadas
End If
End If
Else
HoraUtilUtilizada = "ERR:IniSLA>FimSLA"
End If
Else
HoraUtilUtilizada = "ERR:CamposNulos"
End If
End Function
Function HoraUtilPrevisao(ByVal HoraInicioSLA As Date, ByVal HoraFimSLA As Date, _
ByVal SLAemHoras As Date, ByVal DataInicioSolicitacao As Date, ByVal Feriados As Range) As Variant
Dim qtdHorasDia
Dim diaInicioSolicitacao
Dim horaInicioSolicitacao
Dim saldoHorasSla
qtdHorasDia = HoraFimSLA - HoraInicioSLA
diaInicioSolicitacao = DateSerial(Year(DataInicioSolicitacao), Month(DataInicioSolicitacao), Day(DataInicioSolicitacao))
horaInicioSolicitacao = TimeSerial(Hour(DataInicioSolicitacao), Minute(DataInicioSolicitacao), Second(DataInicioSolicitacao))
If HoraInicioSLA <> 0 And _
SLAemHoras <> 0 And _
HoraFimSLA <> 0 And _
DataInicioSolicitacao <> 0 Then
While verificaFeriado(Feriados.Address(False, False, , True), DataInicioSolicitacao) = True
DataInicioSolicitacao = DataInicioSolicitacao + 1
Wend
If HoraInicioSLA < HoraFimSLA Then
If DataInicioSolicitacao + SLAemHoras > diaInicioSolicitacao + HoraFimSLA Then
If DataInicioSolicitacao > diaInicioSolicitacao + HoraFimSLA Then
saldoHorasSla = SLAemHoras
Else
saldoHorasSla = SLAemHoras - (HoraFimSLA - horaInicioSolicitacao)
End If
'HoraUtilPrevisao = saldoHorasSla
diaInicioSolicitacao = diaInicioSolicitacao + 1
While saldoHorasSla > 0
'ADICIONA 1 DIA E VERIFICA SE É UTIL
While verificaFeriado(Feriados.Address(False, False, , True), diaInicioSolicitacao) = True
diaInicioSolicitacao = diaInicioSolicitacao + 1
Wend
'adiciona o saldo e verifica se é maior que o prazo do sla
If HoraInicioSLA + saldoHorasSla > HoraFimSLA Then
diaInicioSolicitacao = diaInicioSolicitacao + 1
saldoHorasSla = saldoHorasSla - (HoraFimSLA - HoraInicioSLA)
Else
HoraUtilPrevisao = diaInicioSolicitacao + HoraInicioSLA + saldoHorasSla
saldoHorasSla = 0
End If
Wend
Else
'mesmo dia
'VERIFICAR SE O DIA DE ABERTURA É UTIL
If verificaFeriado(Feriados.Address(False, False, , True), diaInicioSolicitacao) = True Then
diaInicioSolicitacao = diaInicioSolicitacao + 1
While verificaFeriado(Feriados.Address(False, False, , True), diaInicioSolicitacao) = True
diaInicioSolicitacao = diaInicioSolicitacao + 1
Wend
HoraUtilPrevisao = diaInicioSolicitacao + SLAemHoras + HoraInicioSLA
Else
If horaInicioSolicitacao < HoraInicioSLA Then
HoraUtilPrevisao = diaInicioSolicitacao + SLAemHoras + HoraInicioSLA
Else
HoraUtilPrevisao = DataInicioSolicitacao + SLAemHoras
End If
End If
End If
Else
HoraUtilPrevisao = "ERR:IniSLA>FimSLA"
End If
Else
HoraUtilPrevisao = "ERR:CamposNulos"
End If
End Function
Sub DescricaoFuncaoHoraUtilPrevisao(Optional a As Boolean)
Dim nomeFuncao As String
Dim DescricaoFuncao As String
Dim categoriaFuncao As String
Dim argumentos(1 To 5) As String
nomeFuncao = "HoraUtilPrevisao"
DescricaoFuncao = "Retorna a data e hora prevista da entrega de uma solicitação, baseado nos parâmetros"
categoriaFuncao = 2
argumentos(1) = "Hora do dia em que o SLA se inicia"
argumentos(2) = "Hora do dia em que o SLA se finaliza"
argumentos(3) = "Prazo do SLA para a solicitação"
argumentos(4) = "Data e hora (dd/mm/aaaa hh:mm) em que a solicitação foi aberta"
argumentos(5) = "Lista de feriados"
Application.MacroOptions _
Macro:=nomeFuncao, _
Description:=DescricaoFuncao, _
Category:=categoriaFuncao, _
ArgumentDescriptions:=argumentos
End Sub
Sub DescricaoFuncaoHoraUtilUtilizada(Optional a As Boolean)
Dim nomeFuncao As String
Dim DescricaoFuncao As String
Dim categoriaFuncao As String
Dim argumentos(1 To 5) As String
nomeFuncao = "HoraUtilUtilizada"
DescricaoFuncao = "Retorna a quantidade de horas úteis utilizadas para atender uma solicitação, baseado nos parâmetros"
categoriaFuncao = 2
argumentos(1) = "Hora do dia em que o SLA se inicia"
argumentos(2) = "Hora do dia em que o SLA se finaliza"
argumentos(3) = "Data e hora (dd/mm/aaaa hh:mm) em que a solicitação foi aberta"
argumentos(4) = "Data e hora (dd/mm/aaaa hh:mm) em que a solicitação foi fechada"
argumentos(5) = "Lista de feriados"
Application.MacroOptions _
Macro:=nomeFuncao, _
Description:=DescricaoFuncao, _
Category:=categoriaFuncao, _
ArgumentDescriptions:=argumentos
End Sub
Private Function verificaFeriado(ByVal RangeFeriados, ByVal dataVerificar As Date) As Boolean
Dim nomePlan As Worksheet
Dim tempNomePlan
'remove a hora da data
dataVerificar = DateSerial(Year(dataVerificar), Month(dataVerificar), Day(dataVerificar))
'trata a o range para retirar o nome da plan e o intervalo de celulas
RangeFeriados = Replace(RangeFeriados, "'", "")
tempNomePlan = Mid(RangeFeriados, InStr(RangeFeriados, "]") + 1, InStr(RangeFeriados, "!") - InStr(RangeFeriados, "]") - 1)
Set nomePlan = ActiveWorkbook.Sheets(tempNomePlan)
RangeFeriados = Mid(RangeFeriados, InStr(RangeFeriados, "!") + 1, Len(RangeFeriados))
If WorksheetFunction.CountIf(nomePlan.Range(RangeFeriados), dataVerificar) > 0 Or _
UCase(WorksheetFunction.Text(dataVerificar, "DDDD")) = "SATURDAY" Or _
UCase(WorksheetFunction.Text(dataVerificar, "DDDD")) = "SUNDAY" Then
'MsgBox "NÃO UTIL"
verificaFeriado = True
Else
verificaFeriado = False
End If
End Function