Notifications
Clear all

Filtro em outra planilha com muitos valores

3 Posts
2 Usuários
0 Reactions
793 Visualizações
engeel2014
(@engeel2014)
Posts: 207
Estimable Member
Topic starter
 

Boa tarde pessoal, tenho uma macro que filtrar dados em outra planilha dependendo dos dados que tenho, porém preciso que esta macro possa filtrar uma quantidade maior de dados.

EX: Hoje a macro consegue fazer o filtro com 50 valores, porém preciso que seja 1500 valores. O codigo de filtro está na planilha "GEDOC" e quando executado ele verifica se a planilha "TOPOGRAFIA" está aberta, se negativo abre a planilha "TOPOGRAFIA", se positivo executa o filtro dentro da planilha "TOPOGRAFIA". Veja o código atual como está escrito.

Alguém pode me ajudar?

Sub FiltrarTeste()
Application.DisplayAlerts = False ' Desabilita notificações da planilha
Dim S As String
Dim rg As Range

Dim X1 As String
Dim X2 As String
Dim X3 As String
Dim X4 As String
Dim X5 As String
Dim X6 As String
Dim X7 As String
Dim X8 As String
Dim X9 As String
Dim X10 As String
Dim X11 As String
Dim X12 As String
Dim X13 As String
Dim X14 As String
Dim X15 As String
Dim X16 As String
Dim X17 As String
Dim X18 As String
Dim X19 As String
Dim X20 As String
Dim X21 As String
Dim X22 As String
Dim X23 As String
Dim X24 As String
Dim X25 As String
Dim X26 As String
Dim X27 As String
Dim X28 As String
Dim X29 As String
Dim X30 As String
Dim X31 As String
Dim X32 As String
Dim X33 As String
Dim X34 As String
Dim X35 As String
Dim X36 As String
Dim X37 As String
Dim X38 As String
Dim X39 As String
Dim X40 As String
Dim X41 As String
Dim X42 As String
Dim X43 As String
Dim X44 As String
Dim X45 As String
Dim X46 As String
Dim X47 As String
Dim X48 As String
Dim X49 As String
Dim X50 As String

S = "TOPOGRAFIA.xlsm"

Windows("GEDOC.xlsm").Activate
Sheets("CONFERENCIA").Select

X1 = Range("c16").Value
X2 = Range("c17").Value
X3 = Range("c18").Value
X4 = Range("c19").Value
X5 = Range("c20").Value
X6 = Range("c21").Value
X7 = Range("c22").Value
X8 = Range("c23").Value
X9 = Range("c24").Value
X10 = Range("c25").Value
X11 = Range("c26").Value
X12 = Range("c27").Value
X13 = Range("c28").Value
X14 = Range("c29").Value
X15 = Range("c30").Value
X16 = Range("c31").Value
X17 = Range("c32").Value
X18 = Range("c33").Value
X19 = Range("c34").Value
X20 = Range("c35").Value
X21 = Range("c36").Value
X22 = Range("c37").Value
X23 = Range("c38").Value
X24 = Range("c39").Value
X25 = Range("c40").Value
X26 = Range("c41").Value
X27 = Range("c42").Value
X28 = Range("c43").Value
X29 = Range("c44").Value
X30 = Range("c45").Value
X31 = Range("c46").Value
X32 = Range("c47").Value
X33 = Range("c48").Value
X34 = Range("c49").Value
X35 = Range("c50").Value
X36 = Range("c51").Value
X37 = Range("c52").Value
X38 = Range("c53").Value
X39 = Range("c54").Value
X40 = Range("c55").Value
X41 = Range("c56").Value
X42 = Range("c57").Value
X43 = Range("c58").Value
X44 = Range("c59").Value
X45 = Range("c60").Value
X46 = Range("c61").Value
X47 = Range("c62").Value
X48 = Range("c63").Value
X49 = Range("c64").Value
X50 = Range("c65").Value

If blPastaTrabalhoAberta(S) Then

Windows("TOPOGRAFIA.xlsm").Activate
Sheets("ENGEEL").Select
If ActiveSheet.FilterMode Then 'Se houver filtro na planilha
ActiveSheet.ShowAllData ' Limpa todos os filtros
End If ' Senão segue o codigo
Range("a6").Select
Set rg = Range("A6")            'Header label for column A
'rg.AutoFilter                   'Remove any existing AutoFilter
Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))  'All the data in column A
rg.AutoFilter Field:=1, Criteria1:=Array(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19, X20, X21, X22, X23, X24, X25, X26, X27, X28, X29, X30, X31, X32, X33, X34, X35, X36, X37, X38, X39, X40, X41, X42, X43, X44, X45, X46, X47, X48, X49, X50), Operator:=xlFilterValues

Else

Workbooks.Open FileName:= _
    "\192.168.0.77topografiaTOPOGRAFIA.xlsm", UpdateLinks:=0
Windows("TOPOGRAFIA.xlsm").Activate
Sheets("ENGEEL").Select
If ActiveSheet.FilterMode Then 'Se houver filtro na planilha
ActiveSheet.ShowAllData ' Limpa todos os filtros
End If ' Senão segue o codigo
Range("a6").Select
Set rg = Range("A6")            'Header label for column A
'rg.AutoFilter                   'Remove any existing AutoFilter
Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))  'All the data in column A
rg.AutoFilter Field:=1, Criteria1:=Array(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19, X20, X21, X22, X23, X24, X25, X26, X27, X28, X29, X30, X31, X32, X33, X34, X35, X36, X37, X38, X39, X40, X41, X42, X43, X44, X45, X46, X47, X48, X49, X50), Operator:=xlFilterValues

End If

Range("A6").Select
Application.DisplayAlerts = True
End Sub

Lucélio Ferreira dos Santos
Eng. Eletricista
CREA: DF-7165/TD
[email protected]

 
Postado : 21/05/2015 12:49 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não tenho certeza desta possibilidade, deve haver alguma forma, mas tem de ser assim ? Não conhecendo seu sistema e a finalidade, mas não teria alguma outra forma de você desenvolve-lo, procurando um outro jeito de se chegar ao resultado que pretende ?

[]s

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

 
Postado : 21/05/2015 10:28 pm
engeel2014
(@engeel2014)
Posts: 207
Estimable Member
Topic starter
 

Não tenho certeza desta possibilidade, deve haver alguma forma, mas tem de ser assim ? Não conhecendo seu sistema e a finalidade, mas não teria alguma outra forma de você desenvolve-lo, procurando um outro jeito de se chegar ao resultado que pretende ?

[]s

Mauro, sou um curioso em VB e o que sei é interpretando e adaptando outros códigos de outras pessoas. Neste caso vi em algum lugar um codigo que filtrava desta maneira aí copiei e adaptei ao que precisava. O que quero é o seguinte: tenho duas planilhas "A.xlsm" e "B.xlsm" quero que na planilha "A.xlsm" quando eu digitar alguns valores numa determinada coluna e depois executar a macro ele irá filtrar estes mesmos valores na planilha "B.xlsm". Não conheço uma forma diferente de fazer este filtro, se puder me sugerir outro modo ou adaptar o atual agradeço. Obrigado.

Lucélio Ferreira dos Santos
Eng. Eletricista
CREA: DF-7165/TD
[email protected]

 
Postado : 22/05/2015 6:07 am