Ir ao conteúdo

Excel Macro para filtrar tabela


Ir à solução Resolvido por Midori,

Posts recomendados

Postado

Como faço uma macro para analisar uma tabela e coleta dados específicos e colar esses dados em outro lugar.

Ex:

 image.png.ded723b9532b702ac92cdad49acb94c5.png

 

Na tabela acima, coletei apenas as letra que possuem 1 em cada linha.

Postado

@Midori  Sem filtro 

image.png.e39a1e5b2605d3ee46894ae92de96ea5.png

 

com filtro 

image.png.033e6fa64eeba8175139742b47b05f9c.png

 

Na verdade nem é exatamente um filtro, é um "localizador", a intenção é localizar valores específicos, copiá-los e colá-los em outro lugar. Nota, pode ignorar as cores, era só pra facilitar vizualmente quem são os dados importantes.

Postado

@Jeff_Sandes A coleta não está na ordem do exemplo, mas o primeiro parâmetro é o valor a ser localizado, o segundo é a tabela com o nome dos campos e o outro é para onde os dados devem ir.

 

Sub Macro()
    Call Coleta(1, [A1:D6], [E2])
End Sub

Sub Coleta(Valor As String, Area As Range, Destino As Range)
    Dim Coluna  As Range
    Dim Conta   As Long
    
    Set Area = Area.Offset(1).Resize(Area.Rows.Count - 1)
        
    For Each Coluna In Area.Columns
        Conta = WorksheetFunction.CountIf(Coluna, Valor)        
        If Conta > 0 Then
            Destino.Resize(Conta) = Coluna.Cells(0).Value
            Set Destino = Destino(Conta + 1)
        End If
    Next Coluna
End Sub

 

Postado

@Midori Acho que devo ter me explicado mal hahaha

 

image.png.5ff1283a2d548820bd09c84cd0aee0d1.png

 

Na verdade, o que estou tentando fazer é encontrar quais letras possuem 1, por exemplo, na primeira linha, quem está com 1 é a letra D, na linha 2 quem está com 1 é a letra A e assim por diante. O resultado vai mostar quais letras possuem 1 em cada linha.

Postado

@Jeff_Sandes No post anterior o 1 aparece duas vezes na D e você colocou esse resultado duas vezes. Se não é para repetir deixe o critério assim,

 

If Conta > 0 Then
    Destino = Coluna.Cells(0).Value
    Set Destino = Destino(2)
End If

 

A ordem do resultado importa?

 

Pode acontecer do 1 aparecer mais de uma vez na mesma linha?

Postado

@Midori  na mesma linha não vai aparece dois valores iguais, por que tem outro algoritmo que insere essa tabela, o algoritmo puxa uma tabela do banco de dados, aí essa macro que estou tentando fazer é pra puxar somente os que estão em 1, e sim, na coluna resultado pode repetir sim as letras,

ex:

 

image.png.34bc45ac6f3fbe88f29d62c28072ed34.png

Postado

@Jeff_Sandes Veja se assim resolve,

Sub Macro()
    Call Coleta(1, [A1:D6], [E2])
End Sub

Sub Coleta(Valor As Variant, Area As Range, Destino As Range)
    Dim Coluna  As Range
    Dim Linha   As Long
    
    For Linha = 2 To Area.Rows.Count
        With WorksheetFunction
            If .CountIf(Area.Rows(Linha), Valor) > 0 Then
                Destino = Area.Cells(1, .Match(Valor, Area.Rows(Linha), 0))
                Set Destino = Destino(2)
            End If
        End With
    Next Linha
End Sub

 

Postado
  Em 14/09/2022 às 17:01, Jeff_Sandes disse:

@OreiaG A planinha não pode conter fórmulas, ... Por isso tô fazendo tudo em VBA.

Expandir  

 

Entendi.

 

Sub Teste()
 Range("E2:E" & Cells(Rows.Count, 1).End(3).Row).FormulaR1C1 = "=INDEX(R1C[-4]:R1C[-1],MATCH(1,RC[-4]:RC[-1],0))"
 Range("E2:E" & Cells(Rows.Count, 1).End(3).Row).Value = Range("E2:E" & Cells(Rows.Count, 1).End(3).Row).Value
End Sub

 

Postado

@Midori  Consegui um jeito de fazer, porém o a macro fica muito extensa em cheia de repetições, tem como deixar o código mais "elegante"?

 

Sub TESTE()
If [C6] = "1" Then
Range("I6") = "A"
ElseIf [D6] = "1" Then
Range("I6") = "B"
ElseIf [E6] = "1" Then
Range("I6") = "C"
ElseIf [F6] = "1" Then
Range("I6") = "D"
End If
If [C7] = "1" Then
Range("I7") = "A"
ElseIf [D7] = "1" Then
Range("I7") = "B"
ElseIf [E7] = "1" Then
Range("I7") = "C"
ElseIf [F7] = "1" Then
Range("I7") = "D"
End If
If [C8] = "1" Then
Range("I8") = "A"
ElseIf [D8] = "1" Then
Range("I8") = "B"
ElseIf [E8] = "1" Then
Range("I8") = "C"
ElseIf [F8] = "1" Then
Range("I8") = "D"
End If
End Sub

 

Isso aqui é só três linhas, imagina se for cem? 😭

Postado
  Em 14/09/2022 às 18:53, Jeff_Sandes disse:

Isso aqui é só três linhas, imagina se for cem? 😭

Expandir  

Não precisa testar cada coluna, é só aplicar uma função para identificar a coluna que tem o valor 1. Fiz isso com a Match. Sobre a quantidade de linhas, isso pode ser resolvido com um loop.

 

Chegou a testar as últimas macros postas aqui no tópico? Elas fazem o que você descreveu.

  • Membro VIP
Postado

@Jeff_Sandes

 

Perde-se muito tempo tentando entender a dúvida, por isso a maioria dos colaboradores só tenta ajudar quando a pessoa anexa uma planilha de exemplo, digitando o resultado esperado.

 

[]s

Postado
  Em 14/09/2022 às 19:24, Midori disse:

Não precisa testar cada coluna

Expandir  

Entendi o motivo de não está funcionando,  o código tava testando as colunas, mas na verdade deveria testar as linhas, outro problema é que as variáveis estão em String.

 

image.png.b83edb84c3ac609c70aab68f8b11e882.png

 

Na tabela tem um ciclo de 24hrs, ex, às 00hrs o silo ativado é o SILO 3, das 01:00 à 06:00 o SILO 1 está ativado.

Tendei fazer um loop pra testar mas não consegui, ainda sou iniciante no VBA😢

Postado
  Em 16/09/2022 às 11:53, Jeff_Sandes disse:

Entendi o motivo de não está funcionando,  o código tava testando as colunas, mas na verdade deveria testar as linhas

Expandir  

Isso não acontece com o último código que postei.

 

  Em 16/09/2022 às 11:53, Jeff_Sandes disse:

outro problema é que as variáveis estão em String.

Expandir  

A macro também funciona com String e vai deixar o resultado igual esse print que postou.

 

Pode anexar a planilha com a macro e os dados desse último print?

  • Solução
Postado

@Jeff_Sandes A macro deve ficar assim,

 

Sub Macro()
    Call Coleta("Active", [B1:E25], [F2])
End Sub

Sub Coleta(Valor As Variant, Area As Range, Destino As Range)
    Dim Coluna  As Range
    Dim Linha   As Long
    
    For Linha = 2 To Area.Rows.Count
        With WorksheetFunction
            If .CountIf(Area.Rows(Linha), Valor) > 0 Then
                Destino = Area.Cells(1, .Match(Valor, Area.Rows(Linha), 0))
            End If
            Set Destino = Destino(2)
        End With
    Next Linha
End Sub

 

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

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

Mostrar 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

Mostrar mais  
×
×
  • Criar novo...