Ir para conteúdo
Fórum Script Brasil
  • 0

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


xmiguelx

Pergunta

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

Link para o comentário
Compartilhar em outros sites

4 respostass a esta questão

Posts Recomendados

  • 0

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

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,7k
×
×
  • Criar Novo...