Ir ao conteúdo
  • Cadastre-se
Regras do Clube do Hardware

Filtro

FSoares.FCS

Por FSoares.FCS
em Microsoft Office e similares

 Compartilhar

Posts recomendados

FSoares.FCS
 

FSoares.FCS

Postado
Postado

Boa tarde Galera, estou com um dilema tenho uma planilha que estou tentando elaborar uma função automática, como não manjo muito do VBA eu uso um pouco a função gravar macro, a planilha tem +- 32 mil linha e quando coloco o filtro para filtrar a palavra "Filial" o sistema para a gravação da macro e mostra o erro "Número excessivo de continuação de linhas", existe uma formula de fazer este filtro?; Se eu fizer normalmente sem usar a gravação o sistema executa normalmente.

Desde já agradeço.

 

segue a macro que estava fazendo e não consigo concluir:


    Cells.Select
    Selection.Copy
    Sheets("Razao").Select
    Range("A1").Select
    ActiveSheet.Paste
    Selection.ColumnWidth = 15
    Columns("F:G").Select
    Range("G1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").ColumnWidth = 4.29
    Columns("D:D").ColumnWidth = 64.29
    Columns("D:D").ColumnWidth = 67.14
    Rows("30558:30558").EntireRow.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Range("A1").Select
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("B2").Select
    Columns("B:B").ColumnWidth = 2.71
    Columns("C:C").ColumnWidth = 5
    Columns("E:E").ColumnWidth = 2.86
    Range("A3").Select
    Rows("3:3").EntireRow.AutoFit
    Columns("B:B").ColumnWidth = 42.57
    Rows("3:3").EntireRow.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:D").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "FILIAL"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "CONTA"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "DATA"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "C.CUSTO"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=RC[4]"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("A5").Select
    Selection.Copy
    Range("A6").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Columns("A:A").Select
    ActiveSheet.Range("$A:$L").AutoFilter Field := 5, Criteria1 := Array( _
        "Filial:0101 CONTA - 3.5.1.01.0101 COMPRAS DE IMOBILIZADOS EM GERAL", _
        "Filial:0101 CONTA - 3.9.1.01.0101 ALIMENTACAO DE FUNCIONARIOS", _
        "Filial:0101 CONTA - 3.9.1.01.0102 CESTAS BASICAS", _
        "Filial:0101 CONTA - 3.9.1.01.0104 CONVENIO MEDICO", _
        "Filial:0101 CONTA - 3.9.1.01.0106 SEGURO DE VIDA EM GRUPO", _
        "Filial:0101 CONTA - 3.9.1.01.0109 MEDICINA OCUPACIONAL/ENGENHARIA DO TRABA", _
        "Filial:0101 CONTA - 3.9.1.01.0112 TELEFONIA", _
        "Filial:0101 CONTA - 3.9.1.01.0114 ENERGIA ELETRICA FABRIL", _
        "Filial:0101 CONTA - 3.9.1.01.0117 ANALISES CLINICAS OCUPACIONAIS", _
        "Filial:0101 CONTA - 3.9.1.01.0119 PEDAGIO SEM PARAR", _
        "Filial:0101 CONTA - 3.9.1.01.0121 LOCACAO EQUIPAMENTO DE INFORMATICA", _
        "Filial:0101 CONTA - 3.9.1.01.0127 ALIMENTACAO FUNCIONARIO- CARTAO", _
        "Filial:0101 CONTA - 3.9.1.01.0129 CONVENIO NORTE DAME", _
        "Filial:0101 CONTA - 3.9.1.01.0130 CONVENIO SULAMERICA SAUDE", _
        "Filial:0101 CONTA - 4.1.2.01.0101 CONSUMO DE MATERIA-PRIMA", _
        "Filial:0101 CONTA - 4.1.2.01.0103 CONSUMO DE MATL.AUXILIAR", _
        "Filial:0101 CONTA - 4.1.2.01.0106 CONSUMO PRODUTO ACABADO", _
        "Filial:0101 CONTA - 4.1.2.01.0201 SALARIOS", _
        "Filial:0101 CONTA - 4.1.2.01.0202 FERIAS", _
        "Filial:0101 CONTA - 4.1.2.01.0207 PREVIDENCIA SOCIAL", _
        "Filial:0101 CONTA - 4.1.2.01.0208 FUNDO DE GARANTIA", _
        "Filial:0101 CONTA - 4.1.2.01.0209 REFEICOES", _
        "Filial:0101 CONTA - 4.1.2.01.0210 CESTA BASICA", _
End Sub

Link para o comentário
Compartilhar em outros sites
Wendell Menezes
 

Wendell Menezes

Postado
Postado

Agora eu entendi. O problema é que o editor VBA aceita no máximo 24 quebras de linha (esses *_* no final da linha).

 

Acredito que você tenha 2 opções.

 

1. Alterar a maneira como você está filtrando os valores (caso isso seja possivel), por exemplo usando *"BOBINADEIRA" para filtar todas as linhas em que essa palavra aparecça.

 

2. Ir granvando a sua macro aos poucos e ir deletando as quebras de linha manualmente. Por exemplo;

 

De: 

Sub Filter()

ActiveSheet.Range("$A$1:$L$30582").AutoFilter Field:=6, Criteria1:=Array( _
    "A", "B", "C", _
    "D", "E", _
    "F", "G", "H")

End Sub

Para: 

Sub Filter()

ActiveSheet.Range("$A$1:$L$30582").AutoFilter Field:=6, Criteria1:=Array("A", "B", "C", "D", "E", "F", "G", "H")

End Sub

 

Link para o comentário
Compartilhar em outros sites
Wendell Menezes
 

Wendell Menezes

Postado
Postado

Eu não sei se te atende, mas outra opção é colocar todos os valores que serão filtrados em uma planilha separada e criar um arranjo com todos eles via macro;

  

Sub Filtrar()

Dim Delimiter As String
Dim List As Variant

Delimiter = "[;]"

With ThisWorkbook.Sheets("Plan2")
    For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        List = List & Delimiter & .Cells(r, 1)
    Next
End With

List = Split(Mid(List, Len(Delimiter) + 1), Delimiter)

ThisWorkbook.Sheets("Razao").Range("A:L").AutoFilter 2, List, 7

End Sub

 

Anexo a sua planilha com essa macro e alguns valores como exemplo.

 

 

6 - Ajuste do Razão por Centro de Custo Analitico.zip

Link para o comentário
Compartilhar em outros sites
FSoares.FCS
 

FSoares.FCS

Postado
  • Autor
Postado

Bom dia Camarada, obrigado pela resposta mas no meu caso não dá para separar o filtro.

A planilha original está no formato abaixo:

image.thumb.png.2584681bb332eb832827eff4ee3e8470.png

Eu incluo 4 coluna no inicio e uso o filtro para separar o filial, centro de custo, conta e data, de forma que fique na mesma linha, exemplo abaixo:

 

image.thumb.png.e787678213f7bc1f7519c6cc0f5ce5c9.png

 

segue anexo a planilha a primeira é a original e a razão é como tem que ficar.Obrigado.

6_-_Ajuste_do_Razão_por_Centro_de_Custo_Analitico22_-_Cópia.zip

Link para o comentário
Compartilhar em outros sites
Wendell Menezes
 

Wendell Menezes

Postado
Postado

O código abaixo cria uma cópia da aba que estiver selecionada, renomeia ela para "Razao" e formata do jeito que você precisa.

  


Sub Razao()

Dim Headers As Variant
Dim LR As Long

Headers = Array("FILIAL", "CONTA", "DATA", "C.CUSTO")
LR = Cells(Rows.Count, 1).End(xlUp).Row

ActiveSheet.Copy , Sheets(1)
ActiveSheet.Name = "Razao"
Columns("A:D").Insert
Columns("C:C").NumberFormat = "dd/mm/aaaa"
Range("A1").Resize(, 4) = Headers
Range("A4").Resize(LR).Formula = "=IF(LEFT(E4,6)=""Filial"",LEFT(E4,11),A3)"
Range("B4").Resize(LR).Formula = "=IF(LEFT(E4,6)=""Filial"",TRIM(MID(E4,12,9999)),B3)"
Range("C4").Resize(LR).Formula = "=IF(ISNUMBER(E4),E4,C5)"
Range("D4").Resize(LR).Formula = "=IF(LEN(E3)=9,E3,D3)"
Calculate
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False

End Sub

Mas qual é relação disso com os filtros?

  • Obrigado 1
Link para o comentário
Compartilhar em outros sites
FSoares.FCS
 

FSoares.FCS

Postado
  • Autor
Postado
Em 28/08/2017 às 14:46, Wendell Menezes disse:

O código abaixo cria uma cópia da aba que estiver selecionada, renomeia ela para "Razao" e formata do jeito que você precisa.

  



Sub Razao()

Dim Headers As Variant
Dim LR As Long

Headers = Array("FILIAL", "CONTA", "DATA", "C.CUSTO")
LR = Cells(Rows.Count, 1).End(xlUp).Row

ActiveSheet.Copy , Sheets(1)
ActiveSheet.Name = "Razao"
Columns("A:D").Insert
Columns("C:C").NumberFormat = "dd/mm/aaaa"
Range("A1").Resize(, 4) = Headers
Range("A4").Resize(LR).Formula = "=IF(LEFT(E4,6)=""Filial"",LEFT(E4,11),A3)"
Range("B4").Resize(LR).Formula = "=IF(LEFT(E4,6)=""Filial"",TRIM(MID(E4,12,9999)),B3)"
Range("C4").Resize(LR).Formula = "=IF(ISNUMBER(E4),E4,C5)"
Range("D4").Resize(LR).Formula = "=IF(LEN(E3)=9,E3,D3)"
Calculate
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False

End Sub

Mas qual é relação disso com os filtros?

Bom dia Camarada.....

Deu certo muito obrigado que Deus lhe abençoe.....

Abraço.

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora
 Compartilhar
Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...