Excel Utilizando VBA para filtrar data, filtrando em dia, mês e ano

[ttake]

Boa noite,
possuo uma planilha que na coluna B possui diversas datas no formato dd/mm/aaaa
em meu Formulário 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 tópicos aqui no fórum, 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 código teria que ter algo com a função Day() month() year() mas não consegui fazer rodar para filtrar o formulário.

exemplo.rar

[Visitante]

 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

obs.

1. mantive o comando Selection.AutoFilter Field:=2 nos três códigos pois não sei qual foi a sua ideia ao colocá-los.

2. os códigos funcionarão com qualquer quantidade de dados (linhas)

3. não encontrei um comando direto para filtrar com o critério dia, primeiro código acima, então apelei para a coluna auxiliar, talvez algum Mestre aqui do fórum conheça @Edson Luiz Branco, @Midori

[ttake]

Obrigado, vou testar

[Visitante]

Eu acompanhei a estrutura dos seus códigos, ou seja,  a filtragem ou é por dia, ou por mês ou por ano.

Se você quiser filtrar de forma diferente então informe TODAS as consultas que você deseja fazer.

 

Amigão, por favor, para responder clique em Responder, abaixo da última postagem, só clique em Citar se necessário.

Você encheu o seu post desnecessariamente com códigos. Por favor edite e apague tudo.

Se necessário colocar códigos no post coloque-os entre Tags (selecione o código em clique no ícone <> no menu do post)

[ttake]

Obrigado Osvaldo, mas 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"
 

 

adicionado 27 minutos depois

Obrigado pela atenção @osvaldomp

Consegui resolver com o código abaixo:

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

 

[Midori]

2 horas atrás, osvaldomp disse:

3. não encontrei um comando direto para filtrar com o critério dia

Um comando direto poderia ser com wildcards, mas teria que converter a coluna das datas para texto para conseguir usar.

 

55 minutos atrás, ttake disse:

Consegui resolver com o código abaixo:

 

Boa solução ocultar as linhas em vez de usar autofiltro

[Edson Luiz Branco]

Bom dia colegas!

O tópico já foi marcado como resolvido então vão desculpando o atraso e a intromissão ...

O AutoFilter até tem algumas facilidades pra filtrar por datas, como por exemplo pegar só os dos meses de fevereiro:

ActiveSheet.AutoFilter.Range.AutoFilter 2,xlFilterAllDatesInPeriodFebruray,xlfilterDynamic

Ou usar xlFilterValues passando uma matriz de pares de valores direto pro  Criteria2 como Array(núm, "data", núm, "data",...) onde núm vai de 0 a 5 (0 pra ano, 1 pra mês, ... 5 pra segundos) só que "data" tem que representar o final do período desejado (como o amigo @OswaldoMP  usou no combobox3 acima), o que daria mais trabalho ainda se fosse fazer para todos os campos.

 

Mas ainda assim daria pra fazer por AutoFilter passando uma matriz com os valores pré-filtrados como argumento para o Criteria1, por exemplo, como no código abaixo, tomando como base seu UserForm.

Obs.: tomei a liberdade de renomear seus ComboBox de 1, 2 e 3 para cboDia, cboMês e cboAno...

Option Explicit
Dim rgDatas As Range
Private Sub UserForm_Initialize()
  ActiveSheet.AutoFilter.ShowAllData
  Set rgDatas = ActiveSheet.AutoFilter.Range.Columns(2)
End Sub
Private Sub cboDia_Change()
  FiltrarValores
End Sub
Private Sub cboMês_Change()
  FiltrarValores
End Sub
Private Sub cboAno_Change()
  FiltrarValores
End Sub
Sub FiltrarValores()
  Dim diaOK As Boolean, mêsOK As Boolean, anoOK As Boolean, valoresOK() As String
  Dim i As Long, k As Long
  With rgDatas
    For i = 2 To .Cells.Count
      If cboDia = "" Then diaOK = True Else diaOK = (Day(.Cells(i)) = 1 * cboDia)
      If cboMês = "" Then mêsOK = True Else mêsOK = (Month(.Cells(i)) = 1 * cboMês)
      If cboAno = "" Then anoOK = True Else anoOK = (Year(.Cells(i)) = 1 * cboAno)
      If diaOK And mêsOK And anoOK Then
        ReDim Preserve valoresOK(k)
        valoresOK(k) = .Cells(i).Text
        k = k + 1
      End If
    Next i
    Select Case k
      Case 0:                .Parent.AutoFilter.Range.AutoFilter 2, "=", xlAnd, "<>"
      Case .Cells.Count - 1: .Parent.AutoFilter.ShowAllData
      Case Else:             .Parent.AutoFilter.Range.AutoFilter 2, valoresOK, xlFilterValues
    End Select
  End With
End Sub

 

AutoFilterPartículasDeDatas.zip