Página 1 de 1

Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 01 Jun 2020 às 18:33
por Yuri
Boa noite,
possuo uma planilha que na coluna B possui diversas datas no formato dd/mm/aaaa
em meu Formulario possuo três Combobox para selecionar e filtrar, sendo um por dia, outro para mês e outro por ano.

Tentei realizar o filtro pelos seguintes código:

Private Sub combobox1_Change()
If ComboBox1.Value <> "" Then
ActiveSheet.Range("$A$1:$C$99999").AutoFilter Field:=2, Criteria1:="*" & ComboBox1.Value & "*"
Else
Selection.AutoFilter Field:=2
End If
End Sub

Private Sub combobox2_Change()
If ComboBox2.Value <> "" Then
ActiveSheet.Range("$A$1:$C$99999").AutoFilter Field:=2, Criteria2:="*" & ComboBox2.Text & "*"
Else
Selection.AutoFilter Field:=2
End If
End Sub

Private Sub combobox3_Change()
If ComboBox3.Value <> "" Then
ActiveSheet.Range("$A$1:$C$99999").AutoFilter Field:=2, Criteria3:="*" & ComboBox3.Text
Else
Selection.AutoFilter Field:=2
End If
End Sub

mas sem sucesso.
Olhei diversos topicos aqui no forum, a maioria tem uma data inicial e outra final para filtro. eu quero por exemplo filtrar apenas 1 mês, ou apenas 1 dia especifico por exemplo ou até mesmo combinando entre um dia, mês e ano especifico.

Acredito que o codigo teria que ter algo com a função Day() month() year() mas não consegui fazer rodar para filtrar o formulário.

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 07:45
por AfonsoMira
Boas adicionei 3 colunas novas que vão estar ocultas.

Veja se é o que pretende.

Alguma dúvida só chamar. :D

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 08:36
por Yuri
AfonsoMira escreveu:Boas adicionei 3 colunas novas que vão estar ocultas.

Veja se é o que pretende.

Alguma dúvida só chamar. :D
Obrigado Afonso,
a idéia é essa, quebra o galho, no entanto quero manter a planilha apenas com dados, sem formulas ou dados repetidos na planilha.
Gostaria de uma solução em VBA, para a filtragem. :D

Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 09:26
por AfonsoMira
Vou ver o que posso fazer aqui.
Assim que tiver algo lhe envio. :D

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 10:07
por AfonsoMira
Veja se seria algo assim ?

Ficheiro em anexo:

:D

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 10:19
por Yuri
AfonsoMira escreveu:Veja se seria algo assim ?

Ficheiro em anexo:

:D
Não funcionou aqui...
Testei filtrando por exemplo dia:01, mês 02,
só que no filtro me aparece as seguintes datas "02/02/2000", " 03/02/2001" deveria aparecer somente "01/02/XXXX"

estava testando com esse outro código, mas acontece o mesmo problema acima:

Private Sub combobox1_Change() 'dia
Dim k As Long, LR As Long
If ComboBox1.Value <> "" Then
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
LR = Cells(Rows.Count, 2).End(3).Row
[D:D] = "": Range("D2:D" & LR) = "=Day(B2)"
[A1:D1].AutoFilter 4, CLng(ComboBox1.Value)
For k = 2 To LR
Cells(k, 4) = ""
Next k
Application.ScreenUpdating = True
Else
Selection.AutoFilter Field:=2
End If
End Sub


Private Sub combobox2_Change() 'mês
Dim s As Long
If ComboBox2.Value <> "" Then
ActiveSheet.AutoFilterMode = False
s = 20 + ComboBox2.Value
[A1:C1].AutoFilter 2, s, 11
Else
Selection.AutoFilter Field:=2
End If
End Sub


Private Sub combobox3_Change() 'ano
If ComboBox3.Value <> "" Then
ActiveSheet.AutoFilterMode = False
[A1:C1].AutoFilter 2, Operator:=xlFilterValues, Criteria2:=Array(0, "1/1/" & ComboBox3.Value)
Else
Selection.AutoFilter Field:=2
End If
End Sub

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 10:40
por AfonsoMira
Fiz umas alterações.
Ora veja agora.

Re: Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 10:52
por AfonsoMira
Tinha me esquecido de actualizar uma parte do código.
Peço desculpa, segue ficheiro em anexo: :D

Utilizando VBA para filtrar data abrindo em dia, mês ano

Enviado: 02 Jun 2020 às 11:04
por Yuri
Perfeito, funcionou obrigado.

código que deu certo é o abaixo:
Código: Selecionar todos
Public ultima_linha As Long
'------Filtra Dia---------
Private Sub combobox1_Change()
    Application.ScreenUpdating = False
    ultima = Range("A10000").End(xlUp).Row
    If ComboBox1.Value <> "" Then
        For i = 2 To ultima
            If Rows(i).EntireRow.Hidden = False Then
                If Left(Cells(i, 2), 2) = ComboBox1.Value Then
                    Rows(i).EntireRow.Hidden = False
                Else
                    Rows(i).EntireRow.Hidden = True
                End If
            End If
        Next i
    Else
        Range("A1:A" & ultima_linha).EntireRow.Hidden = False
    End If
Application.ScreenUpdating = True
End Sub

'----Filtra Mes-----
 Private Sub combobox2_Change()
 Application.ScreenUpdating = False
  ultima = Range("A10000").End(xlUp).Row
  If ComboBox2.Value <> "" Then
    For i = 2 To ultima
    If Rows(i).EntireRow.Hidden = False Then
     If Mid(Cells(i, 2), 4, 2) = ComboBox2.Value Then
    Rows(i).EntireRow.Hidden = False
     Else
     Rows(i).EntireRow.Hidden = True
     End If
     End If
    Next i
    Else
    Range("A1:A" & ultima_linha).EntireRow.Hidden = False
  End If
  Application.ScreenUpdating = True
End Sub

'----Filtra Ano-----
 Private Sub combobox3_Change()
 Application.ScreenUpdating = False
 ultima = Range("A10000").End(xlUp).Row
  If ComboBox3.Value <> "" Then
    For i = 2 To ultima
    If Rows(i).EntireRow.Hidden = False Then
     If Right(Cells(i, 2), 4) = ComboBox3.Value Then
    Rows(i).EntireRow.Hidden = False
     Else
     Rows(i).EntireRow.Hidden = True
     End If
     End If
    Next i
    Else
    Range("A1:A" & ultima_linha).EntireRow.Hidden = False
  End If
  Application.ScreenUpdating = True
End Sub

'---Remove Filtros----
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("A1:A" & ultima_linha).EntireRow.Hidden = False
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
ultima_linha = Range("A10000").End(xlUp).Row
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.ScreenUpdating = False
Range("A1:A" & ultima_linha).EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub