DIA ÚTIL E CONTAGEM DE PRAZO EM DIA ÚTIL.

[xmiguelx]

Olá pessoal,

Preciso de uma mega ajuda:
Tenho uma planilha com duas colunas com fórmulas e gostaria de passar para Macro/VB ao abrir o chamado através do formulário.

Fiz uma planilha de exemplo para facilitar no entendimento.

1) Tenho um formulário onde preencho com alguns dados para abertura de chamado.
==> Ao clicar em enviar eu salvo as informações na sheet SOLICITACAO, e na coluna D eu tenho uma fórmula onde verifico se a data que foi criado o chamado é dia útil, caso seja, será a mesma data e horário da abertura do chamado, caso contrário será o próximo dia útil considerando o horário do inicio da jornada de trabalho conforme o tipo de chamado.
- O Horario do inicio do chamado está na sheet CATEGORIA, coluna E

==> A Coluna L da Sheet SOLICITACAO é calculado o prazo previsto do atendimento considerando o dia e horário da coluna D + o prazo da coluna K, eliminando Sábado, domingo e feriado.
- Tenho uma sheet DSR onde informo os feriados na coluna D.

Abs

Planilha de Exemplo

[Alyson Ronnan Martins]

Boa noite. @xmiguelx

Só para questão de duvida. Você usa qual office?

Exemplo: 2010, 2007, 2016...

[xmiguelx]

Boa Noite Alyson,

Office 2010.

 

Abs

[Alyson Ronnan Martins]

Bom dia.

Esta disponível para explicar a formulá que quer fazer em VBA?

[Alyson Ronnan Martins]

Vou adiantando as informações.

Código de Cadastro:

Sub CadastrarSolicitacao()
Dim LINHAS As Integer
Dim NDay As Double
Dim NDayPrev As Double

    If frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value = "" Then
        MsgBox ("Favor preencher o Tipo de Chamado."), vbCritical, Msg
        frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.SetFocus
    ElseIf frm_ficha_solicitacao.txt_cnpj.Value = "" Then
        MsgBox ("Favor preencher o CNPJ do destinatário."), vbCritical, Msg
        frm_ficha_solicitacao.txt_cnpj.SetFocus
    ElseIf frm_ficha_solicitacao.txt_empresa.Value = "" Then
        MsgBox ("Favor preencher a Empresa."), vbCritical, Msg
        frm_ficha_solicitacao.txt_empresa.SetFocus
    ElseIf frm_ficha_solicitacao.txt_chamado.Value = "" Then
        MsgBox ("Favor descrever á solicitação."), vbCritical, Msg
        frm_ficha_solicitacao.txt_chamado.SetFocus
    Else
        With Sheets("SOLICITACAO")
            'Pesquisa a ultima linha para adcionar as informações
            'LINHA = Sheets("SOLICITACAO").Range("B30000").End(xlUp).Row + 1
            LINHA = .Cells(Rows.Count, "B").End(xlUp).Row + 1
            
            'Iniciar o cadastro das informações
            
            .Range("B" & LINHA).Value = frm_ficha_solicitacao.NCHAMADO.Value
            .Range("C" & LINHA).Value = Now()
            'Recebe o valor do dia util mais próximo:
            If Weekday(Now()) > 1 And _
               Weekday(Now()) < 7 And _
               WorksheetFunction.VLookup(CDbl(Now()), [DSR], 1, 1) <> Int(CDbl(Now())) Then
                NDay = Now()
            Else
                NDay = WorksheetFunction.WorkDay(Now(), 1, [DSR]) + _
                        fnTipoChamadoHoras(frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value, "Início")
                NDayPrev = NDay + _
                            fnTipoChamadoHoras(frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value, "Prazo")
            End If
            
            .Range("D" & LINHA).Value = NDay
            
            
            'Colunas sem informações: (Marcadas em amarelo)
            'E
            'F
            'G
            'H
            
           .Range("I" & LINHA).Value = frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value
            
            For Contador = 3 To Sheets("CATEGORIA").Range("B100").End(xlUp).Row
                If Sheets("CATEGORIA").Range("B" & Contador).Value = frm_ficha_solicitacao.ComboBox_TipoDeCHAMADO.Value Then
                    .Range("J" & LINHA).Value = Sheets("CATEGORIA").Range("D" & Contador).Value
                    .Range("K" & LINHA).Value = Sheets("CATEGORIA").Range("C" & Contador).Value
                End If
            Next Contador
            
            'Recebe o valor do dia util mais próximo:
            
            Sheets("SOLICITACAO").Range("L" & LINHA).Value = NDayPrev
            
            'Colunas sem informações: (Marcadas em amarelo)
            'M
            'N
            
            .Range("O" & LINHA).Value = frm_ficha_solicitacao.txt_cnpj.Value
            .Range("V" & LINHA).Value = frm_ficha_solicitacao.txt_empresa.Value
            .Range("W" & LINHA).Value = frm_ficha_solicitacao.txt_chamado.Value
        End With
    
        MsgBox ("Seu chamar foi aberto sob NÚMERO: " & frm_ficha_solicitacao.NCHAMADO.Value + vbCrLf + vbCrLf + _
                " Prazo para atendimento: " & XXXXXX), vbExclamation, Msg
        
        Unload frm_ficha_solicitacao
    
    End If
    
End Sub

 

Função para identificar a Horas pela Categoria:

Public Function fnTipoChamadoHoras(TipoChadado As String, Tipo As String) As Double
Dim NLinha As Integer
Dim NLinhaAtual As Integer
Dim TipoLinhaAtual As String
    NLinha = Sheets("CATEGORIA").Cells(Rows.Count, "B").End(xlUp).Row
    For NLinhaAtual = 3 To NLinha Step 1
        TipoLinhaAtual = Sheets("CATEGORIA").Range("B" & NLinhaAtual).Value
        If TipoLinhaAtual = TipoChadado Then
            If Tipo = "Prazo" Then
                fnTipoChamadoHoras = Sheets("CATEGORIA").Range("C" & NLinhaAtual).Value
            ElseIf Tipo = "Início" Then
                fnTipoChamadoHoras = Sheets("CATEGORIA").Range("E" & NLinhaAtual).Value
            End If
        End If
    Next NLinhaAtual
End Function

Arquivo: EXEMPLO_DATA&HORA.xlsm

@xmiguelx