Notifications
Clear all

FIltrar Datas em Linhas

5 Posts
2 Usuários
0 Reactions
828 Visualizações
(@gabriel91)
Posts: 2
New Member
Topic starter
 

Boa tarde pessoal,

Não sei macro e estou a quase uma semana com um problema. Gostaria de selecionar datas (que possuem os dados em coluna), inserindo uma data inicial e uma data final.
Alguém pode me ajudar?
O Raciocínio de Solução é:
1) Digite a data inicial
2) Digite a data final
3) Exibir em outra planilha o período correspondente entre as datas inseridas.
Estou Anexando

MUITO OBRIGADO

 
Postado : 06/04/2015 1:10 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Gabriel, o ideal seria ter criado a aba mostrando como deveria ficar o resultado, então veja se o modelo abaixo atende, fiz da forma que entendi.

Filtrar por datas na Horizontal

Qualquer duvida retorne.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/04/2015 10:10 pm
(@gabriel91)
Posts: 2
New Member
Topic starter
 

Mauro é este o Raciocínio mesmo!
Mas está dando um erro:/
Você coloca a data final, aí sai os dados filtrados - ok. Mas quando você tenta de novo, com um intervalo de tempo menor, não consegue filtrar. Fica aparecendo os dados da outra data. Como eu resolvo este problema?
MUITO OBRIGADO

 
Postado : 07/04/2015 5:45 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Gabriel, se entendi, você tem de limpar os resultados para realizar nova filtragem, se for isto troque a rotina pelas abaixo, é só apagar toda e colar estas :
Utilizei uma dica para capturar a Ultima Coluna e Linha com dados, uma vez que teremos Colunas dinamicas, a fonte está na rotina :

Sub VerificaDatasCopia()
Dim lgColDt As Long, k As Long
Dim lastRow As Long
Dim sColDestino As Long
Dim sDtIni
Dim sDtFim

'Chama a rotina para limpar a aba Resultado
'antes de filtrar novamente
Call LimpaDynamicRange

    sDtIni = Range("B2").Value
    sDtFim = Range("E2").Value
        
    'Conta as colunas com datas
    lgColDt = Cells(5, Columns.Count).End(xlToLeft).Column
    
    '1ª Coluna aba destino
    sColDestino = 3

    Application.ScreenUpdating = False

    For k = 3 To lgColDt
    
        lastRow = Cells(65536, k).End(xlUp).Row 'ultima linha na coluna
        
        'Condição das Datas
        If CDate(Cells(5, k).Value) >= CDate(sDtIni) _
                        And CDate(Plan1.Cells(5, k).Value) <= CDate(sDtFim) Then
            
            'Copia
            Range(Cells(5, k), Cells(lastRow, k)).Copy
            
            'Cola somente os valores sem formula
            Worksheets("Resultado").Cells(5, sColDestino).PasteSpecial xlPasteValues
            
            'Incrementa a coluna destino
            sColDestino = sColDestino + 1
        
        End If
        
    Next k

    Worksheets("Resultado").Select
    Worksheets("Resultado").Range("A1").Select
        
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True

End Sub

'Adaptação do site abaixo
'Use Last Column for a Range(F:LastColumn)
'http://stackoverflow.com/questions/16941083/use-last-column-for-a-rangeflastcolumn
Sub LimpaDynamicRange()
    Dim startCol As String
    Dim startRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim myCol As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    Set ws = ThisWorkbook.Sheets("Resultado")
    startCol = "C"
    startRow = 5
    lastRow = ws.Range(startCol & ws.Rows.Count).End(xlUp).Row
    lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
    myCol = GetColumnLetter(lastCol)

    Set rng = ws.Range(startCol & startRow & ":" & myCol & lastRow)
        rng.ClearContents

End Sub

Function GetColumnLetter(colNum As Long) As String
    Dim vArr
    vArr = Split(Cells(1, colNum).Address(True, False), "$")
    GetColumnLetter = vArr(0)
End Function

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/04/2015 8:12 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

talvez uma outra forma..
..Considerando que só tem uma guia em seu arquivo original!

Sub AleVBA_1076257()

Dim LastRow As Double
Dim LastCol As Double
Dim RowCtr As Double
Dim ColCtr As Double
Dim SDate As Double
Dim EDate As Double
Dim FtSht As String
Dim NextCol As Double
FtSht = ActiveSheet.Name


SDate = Cells(2, "B")
EDate = Cells(2, "E")

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "MeDelete"

Sheets(FtSht).Select

LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range(Cells(4, "A"), Cells(LastRow, "B")).Copy Destination:=Sheets("MeDelete").Range("A1")
LastCol = Cells(4, Columns.Count).End(xlToLeft).Column
For ColCtr = 3 To LastCol
    If Cells(4, ColCtr) >= SDate And Cells(4, ColCtr) <= EDate Then
        NextCol = Sheets("MeDelete").Cells(1, Columns.Count).End(xlToLeft).Column + 1
        Range(Cells(4, ColCtr), Cells(LastRow, ColCtr)).Copy
        Sheets("MeDelete").Select
        Cells(1, NextCol).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets(FtSht).Select
    End If
Next ColCtr

End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 08/04/2015 10:29 am