Erro na execução codigo VBA

Anônima
2023-08-31T13:15:35+00:00

Elaborei um código para calcular horas uteis de trabalho porem ele esta apresentando erro na sua execução e não consigo identificar o motivo
Regras desta logica .
Regras : 

  1. O horário de trabalho é das 9:00 as 18:00 de segunda a sexta com 1 hora de almoço 
  2. Tem que desconsiderar sábado domingo e feriados, tenho uma tabela de feriados. 
  3. Se a data da abertura do chamado não for no dia útil ou antes das 9:00hs considerar o primeiro dia útil como inicio as 9:00hs 
  4. Se encerrado após as 18:00hs considerar 18:00hs para encerramento . 
  5. O tempo de horas uteis por dia do colaborador é 8hs. 
  6. Para os dias que forem cheios (9:00hs) deve descontar 1 hora de almoço conforme item 1. 
  7. Se a data encerramento nao for em dias útil considerar primeiro dia útil como encerramento as 9:00hs 

Hora Inicio do Chamado: 01/11/21 11:43:36 

Hora Fim do Chamado: 10/11/21 11:07:50 

O Resultado horas úteis deve ser : 56:24:14

OBS: Vejam no exemplo abaixo que foi desconsiderado os dias 06/11 e 07/11 por ser final de semana porem poderia haver tambem um feriado e desta forma seria desconsiderado como dia util. 

Sub CalcularHorasUteis()

Dim ws As Worksheet 

Set ws = ThisWorkbook.Sheets("Plan2") ' pego planilha 

Dim lastRow As Long 

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' datas de início estão na coluna A2 

Dim holidayRange As Range 

Set holidayRange = ws.Range("H2:H77") ' Substitua "Feriados" 

Dim i As Long 

For i = 2 To lastRow ' Começando da segunda linha para pular cabeçalho 

    Dim inicio As Date 

    Dim fim As Date 

    inicio = ws.Cells(i, 1).Value ' Data de início na coluna A 

    fim = ws.Cells(i, 2).Value ' Data de término na coluna B 

    Dim horasUteis As Double 

    horasUteis = CalcHorasUteis(inicio, fim, holidayRange) 

    ws.Cells(i, 3).Value = horasUteis ' Colocando o resultado na coluna C 

Next i 

End Sub

Function CalcHorasUteis(inicio As Date, fim As Date, feriados As Range) As Double

Dim horasUteis As Double 

Dim current As Date 

current = inicio 

Do While current <= fim 

    If Weekday(current, vbMonday) <= 5 And Not IsHoliday(current, feriados) Then 

        Dim horaInicio As Date 

        Dim horaFim As Date 

        **horaInicio = IIf(current = inicio, MaxTime(current, timeValue("09:00:00")), timeValue("09:00:00"))** 

        horaFim = IIf(current = fim, MinTime(current, timeValue("18:00:00")), timeValue("18:00:00")) 

        horasUteis = horasUteis + (horaFim - horaInicio) 

    End If 

    current = current + 1 

Loop 

CalcHorasUteis = horasUteis 

End Function

Function IsHoliday(dateToCheck As Date, feriados As Range) As Boolean

Dim cell As Range 

For Each cell In feriados 

    If Format(cell.Value, "dd/mm/yyyy") = Format(dateToCheck, "dd/mm/yyyy") Then 

        IsHoliday = True 

        Exit Function 

    End If 

Next cell 

IsHoliday = False 

End Function

Function MaxTime(dateTimeValue As Date, timeValue As Date) As Date

Dim combinedDateTime As Date 

combinedDateTime = dateValue(dateTimeValue) + timeValue(timeValue) 

If combinedDateTime > dateTimeValue Then 

    MaxTime = combinedDateTime 

Else 

    MaxTime = dateTimeValue 

End If 

End Function

Function MinTime(dateTimeValue As Date, timeValue As Date) As Date

Dim combinedDateTime As Date 

combinedDateTime = dateValue(dateTimeValue) + timeValue(timeValue) 

If combinedDateTime < dateTimeValue Then 

    MinTime = combinedDateTime 

Else 

    MinTime = dateTimeValue 

End If 

End Function

Microsoft 365 e Office | Excel | Para empresas | Windows

Pergunta bloqueada. Essa pergunta foi migrada da Comunidade de Suporte da Microsoft. É possível votar se é útil, mas não é possível adicionar comentários ou respostas ou seguir a pergunta.

0 comentários Sem comentários
Resposta aceita pelo autor da pergunta
Anônima
2023-09-01T01:39:28+00:00

Esta resposta foi traduzida automaticamente. Como resultado, pode haver erros gramaticais ou palavras estranhas.

Altere a variável de "timevalue" para outro nome.

Se não quiser, compartilhe mais detalhes sobre seu problema.

Esta resposta foi útil?

1 pessoa achou esta resposta útil.
0 comentários Sem comentários

0 respostas adicionais

Classificar por: Mais útil