Notifications
Clear all

Filtro diferente

12 Posts
2 Usuários
0 Reactions
1,418 Visualizações
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

Bom dia

Acho que essa planilha é de autoria do Patropi, estou usando a mesma como modelo para criar um filtro um pouco diferente do original.

Grato

 
Postado : 20/04/2013 8:39 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Mesmo com o arquivo eu não entendi.....

Att

 
Postado : 20/04/2013 1:28 pm
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

AlexandreVba, é o seguinte:

O filtro "pega" os valores que existem nas três colunas, mediante o parâmetro, que é o "x". Somente os valores que tem o "x" do lado são filtrados e "jogados" em outras três colunas (intervalo).

Grato

 
Postado : 20/04/2013 3:17 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Vou deixar as feras responder em meu lugar, pois ainda não entendi.

A não ser que eu esteja enganado, mas o código abaixo apenas filtra baseado em critério as colunas A,B e C.
E não faz o que você descreveu abaixo.

O filtro localiza na coluna H6:H21, os "x" e copia os valores correspondente ao "x" no intervalo I6:K21 e cola em P6:R21.

Sub Filtrar()

'With Application
'    .ScreenUpdating = False
'    .DisplayAlerts = False
'End With

'On Error Resume Next

If Range("A1") = "AAA" Then filtro = 1
If Range("A1") = "BBB" Then filtro = 2
If Range("A1") = "CCC" Then filtro = 3
If Range("A1") = "DDD" Then filtro = 4
If Range("A1") = "EEE" Then filtro = 5
If Range("A1") = "FFF" Then filtro = 6

Select Case filtro
Case 1
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=1, Criteria1:="AAA"
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=2, Criteria1:="<>"
    Range("B22:C22").Select
    Selection.Copy
    Range("A27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Range("A2").Select
        
Case 2
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=1, Criteria1:="BBB"
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=2, Criteria1:="<>"
    Range("B22:C22").Select
    Selection.Copy
    Range("A28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Range("A2").Select
    
Case 3
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=1, Criteria1:="CCC"
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=2, Criteria1:="<>"
    Range("B22:C22").Select
    Selection.Copy
    Range("A29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Range("A2").Select
    
Case 4
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=1, Criteria1:="DDD"
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=2, Criteria1:="<>"
    Range("B22:C22").Select
    Selection.Copy
    Range("A30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Range("A2").Select
    
Case 5
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=1, Criteria1:="EEE"
    ActiveSheet.Range("$A$1:$c$21").AutoFilter Field:=2, Criteria1:="<>"
    Range("B22:C22").Select
    Selection.Copy
    Range("A31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Range("A2").Select
    
Case 6
    ActiveSheet.ShowAllData
    
End Select
 
Postado : 20/04/2013 7:11 pm
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

Boa noite

Na verdade o que vc postou é o código original. O tipo de filtro que preciso, começa na coluna H, não tendo nenhuma relação com o código original. Postei o original apenas para servir de modelo. Desculpa a confusão.

Grato

 
Postado : 20/04/2013 7:20 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Veja se é isso

 
Postado : 20/04/2013 7:41 pm
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

Bom dia

Bingo, :D é isso mesmo, precisa fazer só mais uma "coisinha", o resultado da filtragem sem formatação, só os valores, tipo assim:

1 2 3
4 5 6
7 8 9

Grato

 
Postado : 21/04/2013 7:36 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Veja se ajuda...

Sub FiltrarOrganizar()
    Range("A1").Select
    Range("A1:D1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "T1:W2"), CopyToRange:=Range("I1:L1"), Unique:=False
        [I2:L500].Sort Key1:=[J1], Order1:=xlAscending
        With ActiveSheet
             Intersect(.UsedRange, .Range("I2:I1000")).ClearContents
        End With
End Sub
 
Postado : 21/04/2013 7:47 am
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

Boa tarde

Meu digníssimo AlexVba, aceite minhas desculpas por omitir outra informação :oops: , os filtrados vão para a plan2 e não plan1 como informado. Com relação a formatação, são copiados apenas os números sem nenhum tipo de formatação, ou seja sem os xis, bordas e cabeçalho.

Grato

 
Postado : 21/04/2013 9:29 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Veja se é isso..
http://www.sendspace.com/file/01flqm

Att

 
Postado : 21/04/2013 10:02 am
(@dimorais)
Posts: 431
Honorable Member
Topic starter
 

Muito grato pela solução :D

 
Postado : 21/04/2013 10:34 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Que bom que resolveu, precisando estaremos aqui ;)

Att

 
Postado : 21/04/2013 12:12 pm