Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pesquisa entre data...
 
Notifications
Clear all

Pesquisa entre datas

 
2024 - VBA & Macros
Post Recente por Juliown 5 anos atrás
6 Posts
2 Usuários
0 Reactions
1,981 Visualizações
RSS
 Juliown
(@juliown)
Posts: 4
New Member
Topic starter
 

Boa tarde, pessoal.

Meu problema é o seguinte:

Estou criando um sistema de consulta entre datas.

Os dados estão em uma planilha e as colunas estão formatadas com data abreviada (dd/mm/aaaa).

Tenho o textbox1 que é a data inicial e o textbox2 que é a data final.

Tenho o textbox3 que é o resultado da busca.

Quando eu digito as datas normais (01/11/2019 a 10/11/2019) ele não trás o resultado, mas se eu digito 11/01/2019 a 11/10/2019, ou seja, invertendo o dia e mês, ele retorna o resultado correto.

Já usei tudo que encontrei (cdate, format, datevalue) mas não resolveu.

Alguém poderia me ajudar, por favor?

Segue meu código para vocês analisarem.

Private Sub TextB_DataF_fc_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Dim dataI, dataF As Date

'dataI = CDate(TextB_DataI_fc.Value)
'dataF = CDate(TextB_DataF_fc.Value)

If TextB_DataI_fc.Value = Empty Then
   MsgBox "É necessário informar as datas.", vbExclamation, "ATENÇÃO!"
   Label124.ForeColor = vbBlue
   TextB_DataI_fc.SetFocus
Exit Sub
End If

If TextB_DataF_fc.Value = Empty Then
   MsgBox "É necessário informar as datas.", vbExclamation, "ATENÇÃO!"
   Label125.ForeColor = vbBlue
   TextB_DataF_fc.SetFocus
Exit Sub
End If

If CDate(TextB_DataF_fc) < CDate(TextB_DataI_fc) Then
   MsgBox "A data final não pode ser menor que a data inicial", vbExclamation, "ATENÇÃO!"
   TextB_DataF_fc = Empty

Exit Sub
   TextB_DataI_fc.SetFocus
End If

TextB_Recbto_fc = Format(WorksheetFunction.SumIfs(Range("recbtoabertovlr"), Range("recbtoabertovenc"), ">=" & TextB_DataI_fc, Range("recbtoabertovenc"), "<=" & TextB_DataF_fc), "currency")
TextB_Pagto_fc = Format(WorksheetFunction.SumIfs(Range("pagtoabertovlr"), Range("pagtoabertovenc"), ">=" & TextB_DataI_fc, Range("pagtoabertovenc"), "<=" & TextB_DataF_fc), "currency")

Label132.Caption = Format(WorksheetFunction.SumIfs(Range("recbtoabertovlr"), Range("recbtoabertovenc"), ">=" & TextB_DataI_fc, Range("recbtoabertovenc"), "<=" & TextB_DataF_fc), "currency")
Label133.Caption = Format(WorksheetFunction.SumIfs(Range("pagtoabertovlr"), Range("pagtoabertovenc"), ">=" & TextB_DataI_fc, Range("pagtoabertovenc"), "<=" & TextB_DataF_fc), "currency")

TextB_SaldoBa_fc.Value = Format(Sheets("Sicoob").Range("D7"), "currency")
If TextB_SaldoBa_fc.Value < 0 Then
   TextB_SaldoBa_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If

Label134.Caption = Format(Sheets("Sicoob").Range("D7"), "currency")
If Label134 < 0 Then
   Label134.ForeColor = RGB(255, 0, 0) 'vbRed
End If

TextB_SaldoCa_fc.Value = Format(Sheets("Caixa").Range("D7"), "currency")
If TextB_SaldoCa_fc.Value < 0 Then
   TextB_SaldoCa_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If
   
Label135.Caption = Format(Sheets("Caixa").Range("D7"), "currency")
If Label135 < 0 Then
   Label135.ForeColor = RGB(255, 0, 0) 'vbRed
End If
   
TextB_Total_fc.Value = Format(CDbl(TextB_Pagto_fc.Value) + CDbl(TextB_Recbto_fc.Value) + CDbl(TextB_SaldoBa_fc.Value) + CDbl(TextB_SaldoCa_fc.Value), "currency")
If TextB_Total_fc.Value < 0 Then
   TextB_Total_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If

Label136.Caption = Format(CDbl(Label132) + CDbl(Label133) + CDbl(Label134) + CDbl(Label135), "currency")
If Label136 < 0 Then
   Label136.ForeColor = RGB(255, 0, 0) 'vbRed
End If

TextB_DataF_fc.SetFocus

End Sub
 
Postado : 13/11/2019 12:16 pm
Reinaldo
 Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Para que possa obter um retorno e que o mesmo atenda sua demanda,sugiro que disponibilize um modelo de seu arquivo (utilize dados ficticios,mas que represente a realidade de sua planilha); pois quem quiser responder somente pela rotina estará apresentando um chute; e com o modelo poderá ser testado.
Inclua se modelo/exemplo em algum site de compartilhamento tipo SendSpace, one Drive, mega.... e informe aqui o link para download

Reinaldo

 
Postado : 13/11/2019 1:30 pm
 Juliown
(@juliown)
Posts: 4
New Member
Topic starter
 

Segue o link da planilha conforme solicitado.

https://drive.google.com/file/d/1ZujEjqQBjUSnAzHorYABNyXwudXAfmMa/view?usp=sharing

 
Postado : 13/11/2019 3:00 pm
Reinaldo
 Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Experimente/teste:

Private Sub TextB_DataF_fc_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If TextB_DataI_fc.Value = Empty Then
   MsgBox "É necessário informar as datas.", vbExclamation, "ATENÇÃO!"
   Label124.ForeColor = vbBlue
   TextB_DataI_fc.SetFocus
Exit Sub
End If

If TextB_DataF_fc.Value = Empty Then
   MsgBox "É necessário informar as datas.", vbExclamation, "ATENÇÃO!"
   Label125.ForeColor = vbBlue
   TextB_DataF_fc.SetFocus
Exit Sub
End If

If CDate(Format(TextB_DataF_fc, "dd/mm/yyyy")) < CDate(Format(TextB_DataI_fc, "dd/mm/yyyy")) Then
   MsgBox "A data final não pode ser menor que a data inicial", vbExclamation, "ATENÇÃO!"
   TextB_DataF_fc = Empty
   TextB_DataI_fc.SetFocus
    Exit Sub
End If

TextB_Recbto_fc = Format(WorksheetFunction.SumIfs(Range("recbtoabertovlr"), Range("recbtoabertovenc"), ">=" & Format(TextB_DataI_fc, "mm/dd/yyy"), Range("recbtoabertovenc"), "<=" & Format(TextB_DataF_fc, "mm/dd/yyyy")), "currency")
MsgBox Format(TextB_DataI_fc, "mm/dd/yyy")
TextB_Pagto_fc = Format(WorksheetFunction.SumIfs(Range("pagtoabertovlr"), Range("pagtoabertovenc"), ">=" & Format(TextB_DataI_fc, "mm/dd/yyy"), Range("pagtoabertovenc"), "<=" & Format(TextB_DataF_fc, "mm/dd/yyyy")), "currency")

Label132.Caption = Format(WorksheetFunction.SumIfs(Range("recbtoabertovlr"), Range("recbtoabertovenc"), ">=" & Format(TextB_DataI_fc, "mm/dd/yyy"), Range("recbtoabertovenc"), "<=" & Format(TextB_DataF_fc, "mm/dd/yyyy")), "currency")
Label133.Caption = Format(WorksheetFunction.SumIfs(Range("pagtoabertovlr"), Range("pagtoabertovenc"), ">=" & Format(TextB_DataI_fc, "mm/dd/yyy"), Range("pagtoabertovenc"), "<=" & Format(TextB_DataF_fc, "mm/dd/yyyy")), "currency")

TextB_SaldoBa_fc.Value = Format(Sheets("Banco2").Range("D7"), "currency")
If TextB_SaldoBa_fc.Value < 0 Then
   TextB_SaldoBa_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If

Label134.Caption = Format(Sheets("Banco2").Range("D7"), "currency")
If Label134 < 0 Then
   Label134.ForeColor = RGB(255, 0, 0) 'vbRed
End If

TextB_SaldoCa_fc.Value = Format(Sheets("Banco1").Range("D7"), "currency")
If TextB_SaldoCa_fc.Value < 0 Then
   TextB_SaldoCa_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If
   
Label135.Caption = Format(Sheets("Banco1").Range("D7"), "currency")
If Label135 < 0 Then
   Label135.ForeColor = RGB(255, 0, 0) 'vbRed
End If
   
TextB_Total_fc.Value = Format(CDbl(TextB_Pagto_fc.Value) + CDbl(TextB_Recbto_fc.Value) + CDbl(TextB_SaldoBa_fc.Value) + CDbl(TextB_SaldoCa_fc.Value), "currency")
If TextB_Total_fc.Value < 0 Then
   TextB_Total_fc.ForeColor = RGB(255, 0, 0) 'vbRed
End If

Label136.Caption = Format(CDbl(Label132) + CDbl(Label133) + CDbl(Label134) + CDbl(Label135), "currency")
If Label136 < 0 Then
   Label136.ForeColor = RGB(255, 0, 0) 'vbRed
End If

TextB_DataF_fc.SetFocus

End Sub

Reinaldo

 
Postado : 13/11/2019 3:39 pm
 Juliown
(@juliown)
Posts: 4
New Member
Topic starter
 

Reinaldo, quando coloco Format, cdate ou datevalue, ele não lê as datas de nenhum jeito.

Sem nenhum tipo de formatação, pelo menos no formato mm/dd/aaaa ele calcula...

 
Postado : 13/11/2019 8:59 pm
 Juliown
(@juliown)
Posts: 4
New Member
Topic starter
 

Reinaldo, não havia percebido o formato que você sugeriu. Coloquei "mm/dd/yyyy" e funcionou certinho, porém a fórmula não está reconhecendo algumas linhas que estão dentro do período selecionado.
Mas isso é assunto para outro tópico.

Muito obrigado pela ajuda!

 
Postado : 14/11/2019 6:24 am
Forum Jump:
  Tópico Anterior
Próximo Tópico