Erro em pesquisa no formulário utilizando datas

Question

Bom dia pessoal,

Eu criei um formulário que pesquisa em uma planilha (utilizada como BD) e exibe o resultado em uma listview. Neste formulário eu posso pesquisar por "Nome" (que está ok) e por "Data" (onde está dando erro)

Na pesquisa por data tenho dois campos:

-Data Inicial

-Data Final

Meu problema é com a data final.

Inicialmente meu problema era que quando a data final era maior que a última data registrada no BD ou quando eu entrava somente com a data inicial ocorria erro. Então eu inseri um código para forçar a data final a não ultrapassar o último valor inserido, porém, agora, mesmo inserindo uma data final válida, ela é alterada para a última data inserida.

Exemplo: Considerando a data de hoje (08/04/2015) como último registro
Se eu digitar no txtBox "dataf" a data 10/04/2015 ela é alterada para 08/04/2015. Até aqui tudo bem, era isso que eu queria.
Mas se eu digitar uma data válida como 04/04/2015 ela também é alterada para 08/04/2015.

Então eu gostaria de saber se tem como acertar isso para que as datas válidas não sejam alteradas.

Segue o código:

'Filtrar somente pelas Datas Inicial e Final'
Private Sub cbtSo2Dts_Click()
    Dim Tmp As Long
    Dim i As Long
    Dim sDtIni As Date
    Dim sDtFim As Date
    
    Tmp = smpPesquisa.lstLista.ListItems.Count
    
        If datai = "" Then
                MsgBox "Digite uma Data Valida", , "Data Inicial Obrigatória !!!"
                datai.SetFocus
            Exit Sub
          End If

    ' * ESTE É O CÓDIGO QUE ALTERA A DATA FINAL'
        If dataf = "" Or dataf > Plan2.Range("F100000").End(xlUp) Then
                 dataf = Plan2.Range("F100000").End(xlUp)
             
        End If
    ' FIM DO CÓDIGO DE ALTERAÇÃO'

    sDtIni = datai.Value
    sDtFim = dataf.Value

  For i = 1 To Tmp
    
        With lstLista
            
           If .ListItems(i).SubItems(5) < sDtIni Then
                smpPesquisa.lstLista.ListItems.Remove i
                    i = i - 1
                    Tmp = Tmp - 1
                        If i = Tmp Then Exit For
                            Tmp = smpPesquisa.lstLista.ListItems.Count
                      
              ElseIf .ListItems(i).SubItems(5) > sDtFim Then
                smpPesquisa.lstLista.ListItems.Remove i
                    i = i - 1
                    Tmp = Tmp - 1
                        If i = Tmp Then Exit For
                            Tmp = smpPesquisa.lstLista.ListItems.Count
                        
              ElseIf .ListItems(i).SubItems(5) = sDtFim Then
            
                    Tmp = Tmp 
                        If i = Tmp Then Exit For
                            Tmp = smpPesquisa.lstLista.ListItems.Count
                        
           End If
                 
        End With

    Next
    
End Sub

Answer 1

PELA LÓGICA, O CÓDIGO ESTÁ CORRETO.

TENTE INSERIR DUAS CAIXAS DE TEXTO QUE SERVIRÃO SOMENTE PARA TESTE.

ELAS DEVERÃO MOSTRAR QUAIS VALORES ESTÃO EM

dataf E Plan2.Range("F100000").End(xlUp)

TEXTBOX1.TEXT = dataf.TEXT

TEXTBOX2.TEXT = Plan2.Range("F100000").End(xlUp).VALUE

VERIFIQUE SE OS VALORES QUE APARECEM NESSAS DUAS CAIXAS DE TESTE SÃO IGUAIS APÓS A EXECUÇÃO DO CÓDIGO

Answer 2

TENTE TAMBÉM FAZER AS SEGUINTES ALTERAÇÕES:

    Dim sDtIni As Date
    Dim sDtFim As Date
    Dim planDtFim As Date



    sDtIni = datai.Value
    sDtFim = dataf.Value
    planDtFim = Plan2.Range("F100000").End(xlUp)
    
    Tmp = smpPesquisa.lstLista.ListItems.Count
    
        If sDtIni = "" Then
                MsgBox "Digite uma Data Valida", , "Data Inicial Obrigatória !!!"
                datai.SetFocus
            Exit Sub
          End If


    ' * ESTE É O CÓDIGO QUE ALTERA A DATA FINAL'
        If sDtFim = "" Or sDtFim > planDtFim Then
                 sDtFim = planDtFim
             
        End If
    ' FIM DO CÓDIGO DE ALTERAÇÃO'

Answer 3

Bom dia Anderson,

Obrigado pela ajuda, mas acabei resolvendo meu problema de outra forma, depois de alguns testes, descobri que um dos problemas era que a data final usada na comparação, caso fosse utilizado o valor da planilha, tinha apenas o dia utilizado na comparação, então se o dia digitado em dataf fosse maior que o último dia registrado independente do mês, a data final da planilha seria utilizada.

Exemplo: valor digitado em dataf: 01/03/2015

                valor do último registro: 08/04/2015

Neste caso o filtro funciona corretamente e a data de 01/03/2015 é utilizada, mas no caso abaixo

Exemplo 2: valor digitado em dataf: 20/03/2015

                   valor do último registro: 08/04/2015

Neste o valor em dataf era considerado maior que o último registro, pois o dia era maior.

Para resolver este problema, eu utilizei uma data fictícia fixa (31/12/9999) para comparação.

O que gerou outro problema "Erro 35600 - Out of bounds", esse erro era devido ao código do filtro em si, então este também foi modificado.

O código final ficou assim:

'Filtrar somente pelas Datas Inicial e Final'
Private Sub cbtSo2Dts_Click()
    Dim i As Long
 
       If datai = "" Then
                MsgBox "Digite uma Data Valida", , "Data Inicial Obrigatória !!!"
                datai.SetFocus
            Exit Sub
        End If

 'Código do Filtro'      
        For i = lstLista.ListItems.Count To 1 Step -1
            If CDate(lstLista.ListItems(i).SubItems(5)) < datai.Value Then
                lstLista.ListItems.Remove i
            ElseIf CDate(lstLista.ListItems(i).SubItems(5)) > dataf.Value Then
                lstLista.ListItems.Remove i
            End If
        Next

End Sub

De qualquer forma, obrigado pela ajuda, e fica o código para quem tiver interesse em fazer algo semelhante.