contar período em DIAS - PARA CONTADOR

[Lamcarter]

Olá pessoal, mais uma das minhas. rsrsrs

 

Estou com dois problemas em dois códigos similares, são:

 

01

Tenho um campo que retorna o período em que um aluno fica acolhido em uma instituição, uso essa:

 

________________________________________________________________________________

Function CalcPeriodoAcolhimento() As StringOn Error GoTo CalcPeriodoAcolhimento_ErrDim sTmp As String ' valor tmp da funçãoDim nDMA As Long ' n Anos, Meses, DiasDim NewDate As Date ' data auxiliar de cálculoDim sSngPlural As String ' string (mês, meses), (ano, anos)Dim dtData1 As Date ' data inicial de cálculoDim dtData2 As Date ' data finalIf IsNull([DataAcolhimento]) Then Exit FunctionEnd IfdtData1 = [DataAcolhimento]dtData2 = Now' Bloco Ano ---------------------' Calcula número inteiro de anosnDMA = DateDiff("yyyy", dtData1, dtData2)' Se Data1+nDMA>Data2, subtrai 1 anoIf DateAdd("yyyy", nDMA, dtData1) > dtData2 ThennDMA = nDMA - 1End IfsSngPlural = " ano, "If nDMA > 1 Then sSngPlural = " anos, "sTmp = nDMA & sSngPlural' Bloco Mês ---------------------' Nova data de referênciaNewDate = DateAdd("yyyy", nDMA, dtData1)nDMA = DateDiff("m", NewDate, dtData2)' Se Data1+nDMA>Data2, subtrai 1 mêsIf DateAdd("m", nDMA, NewDate) > dtData2 ThennDMA = nDMA - 1End IfsSngPlural = " mês e "If nDMA > 1 Then sSngPlural = " meses e "sTmp = sTmp & nDMA & sSngPlural' Bloco Dia ---------------------NewDate = DateAdd("m", nDMA, NewDate)nDMA = DateDiff("d", NewDate, dtData2)sSngPlural = " dia"If nDMA > 1 Then sSngPlural = " dias"sTmp = sTmp & nDMA & sSngPlural' Valor final da funçãoCalcPeriodoAcolhimento = sTmpCalcPeriodoAcolhimento_Fim:Exit FunctionCalcPeriodoAcolhimento_Err:MsgBox Err.DescriptionResume CalcPeriodoAcolhimento_FimEnd Function

________________________________________________________________________

 

A fórmula funciona perfeitamente, porém quando os alunos deixam a instituição, essa fórmula não para, logicamente, TEM COMO ADICIONAR uma terceira condição para que quando estiver preencho o campo SAIDA esse contador parar???

 

=========================================================================================================

 

02 desse mesmo período, preciso extrair em dias.

 

estou tentando mexer na macro, mas nao retorna erro algum, muito menos o resultado.

veja como montei:

-----------------------------------------------------------------------------------------------------------------------------

Function CalcDiasDest() As String' Fornece o Período em que o processo de destituição está tramitando em diasOn Error GoTo CalcDiasDest_ErrDim sTmp As String ' valor tmp da funçãoDim nDMA As Long ' n Anos, Meses, DiasDim dtData1 As Date ' data inicial de cálculoDim dtData2 As Date ' data finalIf IsNull([DataInicioDest]) Then 'Campo DataInicioDest corresponde a data de RECEBIMENTO DA DESTITUICAOExit FunctionEnd IfdtData1 = [DataInicioDest]dtData2 = Now' Bloco Ano ---------------------' Calcula número inteiro de anos'dateDiff("d",#15/05/1980#,date)nDMA = DateDiff("d", dtData1, dtData2)'Se Data1+nDMA>Data2, subtrai 1 anoIf DateAdd("d", nDMA, dtData1) > dtData2 ThennDMA = nDMA - 1CalcDiasDest = sTmpEnd IfnDMA = DateDiff("d", dtData1, dtData2)' Se Data1+nDMA>Data2, subtrai 1 anoIf DateAdd("d", nDMA, dtData1) > dtData2 ThennDMA = nDMA - 1End IfsTmp = nDMACalcDiasDest_Fim:Exit FunctionCalcDiasDest_Err:MsgBox Err.DescriptionResume CalcDiasDest_FimEnd Function

------------------------------------------------------------------------------------------------

Mas como dito nao retorna erro nem os dias entre as datas.

 

Grato pela atenção

[Visitante]

situação 1

substitua esta linha

dtData2 = Now

por esta

dtData2 = IIf([A1] <> "", [A1], Date)

funcionamento - se houver uma data em "A1" a função retorna o tempo de acolhimento até aquela data, se não, retorna o tempo até a data atual (altere a célula se quiser)

#####################################################################
situação 2 (não utilizei o segundo código, aproveitei o primeiro e acrescentei o total de dias no resultado da função, veja se atende)

 

substitua esta linha (no primeiro código)

CalcPeriodoAcolhimento = sTmp

por esta

CalcPeriodoAcolhimento = sTmp & "  (" & DateDiff("d", dtData1, dtData2) & "  dias)"

#####################################################################
sugestão - se desejar atualizar automaticamente o resultado da função após alterar a data de entrada ou a data de saída, acrescente a segunda linha abaixo no seu código

Function CalcPeriodoAcolhimento() As StringApplication.Volatile

[Lamcarter]

 

situação 1

substitua esta linha

dtData2 = Now

por esta

dtData2 = IIf([A1] <> "", [A1], Date)

funcionamento - se houver uma data em "A1" a função retorna o tempo de acolhimento até aquela data, se não, retorna o tempo até a data atual (altere a célula se quiser)

#####################################################################

situação 2 (não utilizei o segundo código, aproveitei o primeiro e acrescentei o total de dias no resultado da função, veja se atende)

 

substitua esta linha (no primeiro código)

CalcPeriodoAcolhimento = sTmp

por esta

CalcPeriodoAcolhimento = sTmp & "  (" & DateDiff("d", dtData1, dtData2) & "  dias)"

#####################################################################

sugestão - se desejar atualizar automaticamente o resultado da função após alterar a data de entrada ou a data de saída, acrescente a segunda linha abaixo no seu código

Function CalcPeriodoAcolhimento() As StringApplication.Volatile

 

 

Olá Osvaldo.

 

Primeiramente agradeço imensamente sua resposta é de muita valia.

 

Situação 01

 

Não funcionou o código, no meu caso ficou assim:

 

dtData1 = [DataAcolhimento]

dtData2 = IIf([DataDesacolhimento] <> "", [DataDesacolhimento], Date)

 

porém ele continua contando até a data atual.

olha eu não entendo de vba, mas no exemplo que você colou, aparentemente as palavras "IIF", "Date"  e as "aspas" deveriam aparecer de cor diferente, o que não ocorre, será que é por isso?

 

Situação 02

 

Funcionou perfeitamente, isso mesmo que eu queria, imensamente agradecido.

 

Sugestão

 

Como informado, não tenho amplos conhecimentos em VBA, na verdade quando comecei a desenvolver o sistema, isso há muito tempo, era esse comando que procurava, mas não encontrei, então a macro de idade e período de acolhimento está no diretamente no formulário. Realmente seria muito interessante conseguir mandar esse dado para a tabela, mas não sei como fazer, assim eu não consigo fazer relatórios com esse dado, uma vez que ele não vai para a tabela, mas muito obrigado, anotei ela e quando terminar as alterações pontuais que tenho que fazer, irei me debruçar nessa questão.

. 

 

Se puder me auxiliar com a situação 01 agradeço muito.

 

Att.

 

Lamcarter

[Visitante]

Cara, aqui funciona até com o comando que você modificou:

dtData2 = IIf([DataDesacolhimento] <> "", [DataDesacolhimento], Date)

 

Se a função aí está calculando sempre até a data atual, então talvez o intervalo DataDesacolhimento esteja vazio aí na sua planilha. Nada relacionado com a cor das aspas!

Você testou com o comando que passei utilizando "A1"?

 

Se não conseguir resolver sugiro que você diponibilize uma amostra do seu arquivo com a função instalada.