Este fórum está sendo desativado

[anacletotranstusa]

Boa Tarde,
Modelo Anexo!
Mais uma vez, venho solicitar auxílios. Não estou conseguindo executar filtro avançado.
Preciso utilizar o filtro avançado entre datas, exemplo entre as datas 07/08/2015 e 18/08/2015, na consultar estou digitando na Célula "Q2" >=07/08/2015 e na Celula "R2" <=18/08/2015, não me apresenta os dados referente a essas datas.
Grato!

[alexandrevba]

Boa tarde!!!

Considerando que os dados estão em A5:H5, e que os valores são realmente datas

Código: Selecionar todos

Sub AleVBA_740()
    Dim r As Range, filt As Range, d1 As Date, d2 As Date
    With Worksheets("Dados")
        d1 = .Range("Q2").Value
        d2 = .Range("R2").Value
        .Range("D5").CurrentRegion.AutoFilter Field:=.Range("D5").Column, Criteria1:=">=" & CDate(d1) _
        , Operator:=xlAnd, Criteria2:="<=" & CDate(d2)
        Set filt = .Range("D5").CurrentRegion.SpecialCells(xlCellTypeVisible)
         'filt.Copy
        With Worksheets("Dados") 'Caso queira copiar par aoutra guia
            '.Cells.Clear
            filt.Copy
            .Range("P5").PasteSpecial
            '.Range("A1:B1").EntireColumn.AutoFit
        End With
        .Range("D5").CurrentRegion.AutoFilter
    End With
End Sub

Att

[anacletotranstusa]

Boa Tarde Alexandre,
Poderia me auxilar novamente, tentei implementar seu código, porem não consegui chegar no resultado.
Anexo minha tentativa, precisaria que pudesse filtrar entre as datas e pelos carros. Caso não informasse nenhum dado e clicasse em filtrar seja apresentado todos os registros.
Desde já agradeço sua atenção.

[alexandrevba]

Bom dia!!

Veja se ajuda.
Esse código em inserir dentro de um controle activeX do tipo botão

Código: Selecionar todos

Option Explicit

Private Sub CommandButton21_Click()
CommandButton21.Caption = "Resetar"
Application.ScreenUpdating = False
    If Plan5.AutoFilterMode = False Then
    Dim r As Range, filt As Range, d1 As Long, d2 As Long, Crt As Long
        With Worksheets("Dados")
            .Range("P5:W10000").ClearContents
            Crt = .Range("P2").Value
            d1 = .Range("Q2").Value
            d2 = .Range("R2").Value
            .Range("B1").CurrentRegion.AutoFilter Field:=.Range("B1").Column, Criteria1:="=" & Crt
            .Range("D1").CurrentRegion.AutoFilter Field:=.Range("D1").Column, Criteria1:=">=" & CLng(d1) _
            , Operator:=xlAnd, Criteria2:="<=" & CLng(d2), VisibleDropDown:=False
            Set filt = .Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible)
             'filt.Copy
            With Worksheets("Dados") 'Caso queira copiar par aoutra guia
                filt.Copy
                .Range("P5").PasteSpecial
                .Range("P5:W5").EntireColumn.AutoFit
            End With
            'Caso não queira ver a ação do filtro descomentar a linha abaixo
            '.Range("D1").CurrentRegion.AutoFilter
        End With
    Else: Plan5.CommandButton21.Caption = "Resetar"
        Plan5.AutoFilterMode = False
        Plan5.CommandButton21.Caption = "Filtrar"
    End If
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[anacletotranstusa]

Boa Tarde,
Não consegui fazer funcionar. Modelo anexo.

[alexandrevba]

Boa tarde!!!

Segue o arquivo, por favor click na mãozinha!!!


Att

[anacletotranstusa]

Boa noite Alexandre,
Como funciona? Baixei seu exemplo, tentei filtrar outras informações e não é apresentado o resultado esperado.

[alexandrevba]

Bom dia!!

Como funciona?

Digite um valor no campo carro, data Inc e data Fin, depois click no botão!

Nos meus testes eu não tive problema!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Att

[anacletotranstusa]

Bom dia!
Perfeito! Perguntei como funciona achando que poderia ter alguma configuração a parte. Pois baixei seu exemplo ontem e não funcionou, só apaguei os valores da pesquisa e cliquei no botão não me apresentou nenhum registro, achei que não estava funcionado. Por incrível que pareça, não sei explicar, baixei novamente seu exemplo salvei na minha máquina, abri o arquivo salvo na máquina, realizei o teste e funcionou perfeitamente. .
Pois bem, agora estou com outra dificuldade, no seu código, você deixou claro que se 'Caso queira copiar para outra guia' alterasse o código, With Worksheets("Dados"). Com essa ideia, criei outra aba chamada "Pesquisa", transferi os campos Carros, Data inic, Data Fim, para as células A2; B2; C2 da aba "Pesquisa", os dados pesquisados deveria ser apresentado a partir da Celula A5:H5.
Alteração feita no código do Botão, porem não consegui que mostrasse o resultado esperado:
Private Sub CommandButton1_Click()
CommandButton1.Caption = "Resetar"
Application.ScreenUpdating = False
If Plan5.AutoFilterMode = False Then
Dim r As Range, filt As Range, d1 As Long, d2 As Long, Crt As Long
With Worksheets("Dados")
.Range("A5:H10000").ClearContents
Crt = Worksheets("Pesquisa").Range("A2").Value
d1 = Worksheets("Pesquisa").Range("B2").Value
d2 = Worksheets("Pesquisa").Range("C2").Value
Worksheets("Dados").Range("B1").CurrentRegion.AutoFilter Field:=.Range("B1").Column, Criteria1:="=" & Crt
Worksheets("Dados").Range("D1").CurrentRegion.AutoFilter Field:=.Range("D1").Column, Criteria1:=">=" & CLng(d1) _
, Operator:=xlAnd, Criteria2:="<=" & CLng(d2), VisibleDropDown:=False
Set filt = Worksheets("Dados").Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible)
'filt.Copy
With Worksheets("Pesquisa") 'Caso queira copiar par aoutra guia
filt.Copy
.Range("A5").PasteSpecial
.Range("A5:H5").EntireColumn.AutoFit
End With
'Caso não queira ver a ação do filtro descomentar a linha abaixo
'.Range("D1").CurrentRegion.AutoFilter
End With
Else: Plan1.CommandButton1.Caption = "Resetar"
Plan5.AutoFilterMode = False
Plan1.CommandButton1.Caption = "Filtrar"
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[alexandrevba]

Bom dia!!

Por favor reinstale seu office ou compre outra ferramenta..rsrsrs

Eu não estou tendo esses problemas!!!!!!!!

Att

[anacletotranstusa]

Bom dia Alexandre,
Na verdade, depois que salvei o arquivo na minha maquina o filtro funciono.
O problema agora seria fazer o filtro em outra aba, exemplo anexo, não consigo fazer o botão buscar os dados da aba Dados.
Poderia mais uma vez me auxiliar?

[alexandrevba]

Bom dia!!

Eu não entendi, na minha imagem, eu demonstrei como filtrar e colar em outra aba.

O filtro foi feito "Dados" e o resultado na aba "Pesquisa", não seria isso que você deseja?

Att

[anacletotranstusa]

Peço desculpas antes seria isso mesmo, mas agora, desejaria que o usuário fizesse o filtro na aba pesquisa. No exemplo que anexei, foi deixado o filtro na aba dados, mas preciso que o filtro seja executado na aba pesquisa.

Grato pela atenção.

[alexandrevba]

Boa tarde!!

Veja

Código: Selecionar todos

Private Sub CommandButton1_Click()
CommandButton1.Caption = "Resetar"
Application.ScreenUpdating = False
    If Plan5.AutoFilterMode = False Then
    Dim r As Range, filt As Range, d1 As Long, d2 As Long, Crt As Long
    Worksheets("Dados").Activate
        With Worksheets("Pesquisa")
            Worksheets("Pesquisa").Range("A5:H10000").ClearContents
            Crt = Worksheets("Pesquisa").Range("A2").Value
            d1 = Worksheets("Pesquisa").Range("B2").Value
            d2 = Worksheets("Pesquisa").Range("C2").Value
            Worksheets("Dados").Range("B1").CurrentRegion.AutoFilter Field:=.Range("B1").Column, Criteria1:="=" & Crt
            Worksheets("Dados").Range("D1").CurrentRegion.AutoFilter Field:=.Range("D1").Column, Criteria1:=">=" & CLng(d1) _
            , Operator:=xlAnd, Criteria2:="<=" & CLng(d2), VisibleDropDown:=False
            Set filt = Worksheets("Dados").Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible)
             'filt.Copy
            With Worksheets("Pesquisa") 'Caso queira copiar par aoutra guia
                filt.Copy
                Worksheets("Pesquisa").Range("A5").PasteSpecial
                Worksheets("Pesquisa").Range("A5:H5").EntireColumn.AutoFit
            End With
            'Caso não queira ver a ação do filtro descomentar a linha abaixo
            '.Range("D1").CurrentRegion.AutoFilter
            Worksheets("Pesquisa").Activate
        End With
    Else: Plan1.CommandButton1.Caption = "Resetar"
        Plan5.AutoFilterMode = False
        Plan1.CommandButton1.Caption = "Filtrar"
    End If
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Att

[anacletotranstusa]

Show de Bola Alexandre!
Muito Obrigado....