Notifications
Clear all

tirar fds

3 Posts
2 Usuários
0 Reactions
889 Visualizações
(@leko_leo)
Posts: 6
Active Member
Topic starter
 

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

 
Postado : 16/07/2014 6:56 am
(@edcronos)
Posts: 1006
Noble Member
 

monte uma planilha de exemplo
e aplique o código
vai facilitar o entendimento
pelo menos para mim entender isso sem ver em funcionamento é meio complicado.

at

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 16/07/2014 7:53 am
(@leko_leo)
Posts: 6
Active Member
Topic starter
 

Segue em anexo.

 
Postado : 16/07/2014 9:48 am