Página 1 de 1
Pesquisa Entre Datas
Enviado: 15 Set 2020 às 14:32
por SMuralha
Boa Tarde!
Favor verificar a possibilidade de se quando entrar com uma data inicial (célula J1) e uma data final (célula J2) , exibam somente os dados das respectivas datas selecionadas, no exemplo da planilha anexa, ao se escolher as datas entre 05/08/2020 até 10/09/2020 apareceriam somente os dados referentes a essas datas.
Ressalva: Existe uma planilha “Painel_Controle” agregada ao arquivo cujo sua atualização é automática em função das entradas de dados na planilha “DADOS”, a minha dúvida é: ao escolher as datas referencias por exemplo: 05/08/2020 até 10/09/2020 a planilha “Painel_Controle” também será devidamente atualizada com os referidos dados?
OBS: As entradas de dados na planilha “DADOS” são ilimitados.
Desde já agradeço
Re: Pesquisa Entre Datas
Enviado: 15 Set 2020 às 15:57
por mucascosta
Código: Selecionar todosSub Filtrar()
On Error GoTo Erro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
If Plan1.Range("J1").Value = "" Or Plan1.Range("J2").Value = "" Then
MsgBox "Informe Início e Fim", vbCritical, "FILTRO"
Exit Sub
End If
Dim Linha As Long
Dim Data As Date
Dim DataInicial As Date
Dim DataFinal As Date
DataInicial = Plan1.Range("J1").Value
DataFinal = Plan1.Range("J2").Value
Linha = 4
With Plan1
Do
Linha = Linha + 1
On Error Resume Next
Data = Cells(Linha, 1).Value
If Data >= DataInicial And Data <= DataFinal Then
Else
.Rows(Linha).EntireRow.Hidden = True
End If
Loop Until Cells(Linha, 1).Value = ""
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "ERRO"
End Sub
Sub Reexibir()
On Error GoTo Erro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Dim Linha As Long
Linha = 4
With Plan1
Do
Linha = Linha + 1
.Rows(Linha).EntireRow.Hidden = False
Loop Until Cells(Linha, 1).Value = ""
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "ERRO"
End Sub
Pesquisa Entre Datas
Enviado: 16 Set 2020 às 13:54
por SMuralha
Boa Tarde! Prezado mucascosta 15 Set 2020 às 15:57
Primeiramente muito obrigado pela ajuda.
A ideia é essa mesmo, criei os botões “PESQUISAR” e “RESET” acrescentando a eles sua macro, lancei uma data inicial (J1) e uma data final (J2), funcionou perfeitamente.
Porém....
Quando troco os filtros de consulta (“J1” e “J2”) para novas datas e clico no botão “PESQUISAR” , a nova pesquisa torna-se sem efeito, mantendo os dados da pesquisa anterior, observei entretanto, que se clicar no botão “RESET” e novamente no botão “PESQUISAR” aí a nova pesquisa funciona.
Caso seja possível, por gentileza peço que dê uma reavaliada no código a fim de viabilizar as condições abaixo:
• Sempre que houver troca de datas em (J1) e (J2) que seja necessário somente clicar no botão “PESQUISAR” para consumar as pesquisas, sem necessidades de utilizar o botão “RESET”.
• Manter a funcionalidade do botão “RESET”, pois como Você pode notar a planilha é uma tabela de dados e preciso sempre atualizar e mantendo o botão “RESET” consigo visualizar todos os dados e dar prosseguimento as inserções de novos dados.
Ressalva: A solução ficou muito boa, caso não seja possível possível fazer as alterações acima, mesmo assim vou implementar com a sua solução anterior.
Desde já agradeço!
Re: Pesquisa Entre Datas
Enviado: 16 Set 2020 às 14:55
por mucascosta
Creio que assim resolve, No evento sub Filtrar():
antes de If Plan1.Range("J1").Value = "" Or Plan1.Range("J2").Value = "" Then
Inclua Call Reexibir
Pesquisa Entre Datas
Enviado: 17 Set 2020 às 13:04
por SMuralha
Boa Tarde! Prezado mucascosta 16 Set 2020 às 14:55
Primeiramente Obrigado Pela Ajuda e Pela Paciência.
Funcionou...Show de Bola.
Muito Obrigado.