Excel - Macro (Classificar e Extrair)

danilima15 · 3 de setembro de 2013

Olá pessoal, bom dia, tudo bem?

Estou precisando de uma super ajuda com uma macro que se for possível fazer da forma que eu preciso, rentabilizará muito meu trabalho :-)

O arquivo do qual vou falar é este:

https://www.wetransfer.com/downloads/c9c1d85b1c04861fc321ed7424ef20a220130903132302/a2de033d1c8ee8e69d94086d744a774120130903132302/fa0f2f

Neste relatório tem a primeira planilha chamada RANKING e as demais planilhas com os nomes dos targets (AS AB 18+, AS AB 18-49, AS AB 25+...etc), o que preciso fazer é:

- Nestas planilhas dos targets, existe a mesma informação 2x, onde os dados que estão no intervalo de B4 : D52, preciso classificar pela coluna C (Audiência) na ordem do maior para o menor e os dados que estão no intervalo de G4 : I52, preciso classificar pela coluna I (Afinidade) na ordem do maior pelo menor.

Não sou especilista em macros, VBA ou algo assim, então consegui gravar uma macro onde classifico estes dados, mas tenho que fazer isso em planilha por planilha e gostaria que a macro já classificasse todas as planilhas de uma vez, imaginem que as vezes tenho 60 planilhas e tenho que executar a macro de classificação em cada uma delas e ainda por cima, pra macro funcionar preciso sempre posicionar meu primeiro bloco de informações a partir das células b3 e o segundo bloco de informações a partir da h3, quando faço diferente, sei lá porque a macro não funciona o código da macro poderá ser visto neste arquivo: https://www.wetransfer.com/downloads/5bb7a2e48660ec6f891ad635e00cabf620130903132724/7af3cd

- Depois de classificar, preciso que esta macro extraia de todas as planilhas no intervalo de A4 : D52 a POSIÇÃO DO RANKING das audiências, CANAL, AUDIÊNCIA e AFINIDADE toda vez que aparecer o CANAL 8 e cole estas informações na planilha RANKING, a partir da célula B5 e que se for seguir a sequencia sempre vai colar as informações na ordem B5 : D5, B6 : D6, etc..., mas a informação do target deverá ser extraída do nome das próprias planilhas (tem como?)

-E para completar, preciso que esta mesma macro extraia de todas as planilhas no intervalo de F4 : I52 a POSIÇÃO DO RANKING das afinidades, CANAL, AUDIÊNCIA e AFINIDADE toda vez que aparecer o CANAL 8 e cole estas informações na planilha RANKING, a partir da célula G5 e que ser seguir a sequencia sempre vai colar as informações na ordem G5 : I5, G6 : I6, etc..., mas a informação do target deverá ser extraída do nome das próprias planilhas, assim como no item anterior.

Segue arquivo com um exemplo de como a planilha RANKING deve ficar:

https://www.wetransfer.com/downloads/c2e20ec858d7654e255619de3f2710bb20130903132319/5e28e21ce5707d473eed9fa327939a1320130903132319/d9e75b

Pessoal, muitissímo obrigada pela ajuda Beijo

vinibpeixoto · 6 de setembro de 2013

Olá, danilima15,

Adicionei um botão à planilha Ranking e atribuí (ao botão) o código abaixo.


Private Sub CommandButtonOrdenarExtrair_Click()
    Application.ScreenUpdating = False

    Dim canal As String
    'Solicita o canal em que deseja-se a extração da posição do ranking
    canal = InputBox("Qual o canal desejado?", "Canal", "Canal 8")

    'Define a primeira coluna da planilha Ranking, em que os dados
    'ordenados por audiência serão copiados (abaixo, coluna A - coluna número 1)
    Dim colunaAudiencia As Integer
    colunaAudiencia = 1

    'Realiza a mesma definição acima, mas para os dados ordenados por
    'afinidade (abaixo, coluna F - coluna número 6)
    Dim colunaAfinidade As Integer
    colunaAfinidade = 6

    'Define a primeira linha da planilha Ranking, em que os dados
    'ordenados serão copiados (abaixo, linha 5) - de acordo com as colunas
    'anteriores, os dados serão copiados a partir das células A5 e F5
    Dim linha As Integer
    linha = 5

    'Se nenhum canal foi informado, não faz nada
    If Len(canal) > 0 Then
        'Percorre todas as planilhas
        For Each planilha In ThisWorkbook.Sheets
            'Se não for a planilha Ranking, realiza a ordenação
            If planilha.Name <> "Ranking" Then
                'Ordena os dados entre as células B4 e D52,
                'de acordo com os dados da coluna C
                Worksheets(planilha.Name).Range("B4:D52").Sort _
                    Key1:=Worksheets(planilha.Name).Columns("C"), Order1:=xlDescending
                'Ordena os dados entre as células G4 e I52,
                'de acordo com os dados da coluna I
                Worksheets(planilha.Name).Range("G4:I52").Sort _
                    Key1:=Worksheets(planilha.Name).Columns("I"), Order1:=xlDescending

                'Simula a função CORRESP, para saber em qual linha o canal
                'procurado encontra-se - dentre os dados ordenados por
                'audiência
                Dim correspAudiencia As Double
                correspAudiencia = WorksheetFunction.Match(canal, _
                    Worksheets(planilha.Name).Range("B4:B52"), _
                    0)

                'Simula a função ÍNDICE, para saber a posição do ranking do
                'canal procurado e seus demais dados, através do número da
                'linha obtido anteriormende
                Dim posicaoAudiencia As Double
                Dim audienciaAudiencia As Double
                Dim afinidadeAudiencia As Double
                posicaoAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("A4:A52"), _
                    correspAudiencia)
                audienciaAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("C4:C52"), _
                    correspAudiencia)
                afinidadeAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("D4:D52"), _
                    correspAudiencia)

                'Realiza o mesmo, mas para os dados ordenados por
                'afinidade
                Dim correspAfinidade As Double
                correspAfinidade = WorksheetFunction.Match(canal, _
                    Worksheets(planilha.Name).Range("G4:G52"), _
                    0)

                Dim posicaoAfinidade As Double
                Dim audienciaAfinidade As Double
                Dim afinidadeAfinidade As Double
                posicaoAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("F4:F52"), _
                    correspAfinidade)
                audienciaAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("H4:H52"), _
                    correspAfinidade)
                afinidadeAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("I4:I52"), _
                    correspAfinidade)

                'Copia os dados para a planilha Ranking
                Cells(linha, colunaAudiencia).Value = planilha.Name 'Target
                Cells(linha, colunaAudiencia + 1).Value = posicaoAudiencia 'Posição
                Cells(linha, colunaAudiencia + 2).Value = audienciaAudiencia 'Audiência
                Cells(linha, colunaAudiencia + 3).Value = afinidadeAudiencia 'Afinidade

                Cells(linha, colunaAfinidade).Value = planilha.Name 'Target
                Cells(linha, colunaAfinidade + 1).Value = posicaoAfinidade 'Posição
                Cells(linha, colunaAfinidade + 2).Value = audienciaAfinidade 'Audiência
                Cells(linha, colunaAfinidade + 3).Value = afinidadeAfinidade 'Afinidade

                linha = linha + 1
            End If
        Next planilha
    End If

    Application.ScreenUpdating = True
End Sub

Fiz o upload do arquivo alterado em http://www.sendspace.com/file/lmy6ao.

danilima15 · 10 de setembro de 2013

Vini, mais uma vez você me ajudou :-) muito obrigada!

Como mandei a planilha como exemplo e minhas infos eram "fakes", agora estou tentado adaptar a macro ao meu arquivo real, quando der certo, passarei aqui pra te contar.

Mas vendo o exemplo pronto que você me mandou já sei que vou economizar muito tempo do meu dia, passava muitas horas fazendo todo este trâmite.

Beijo e mais uma vez obrigada

Vini,

Olha eu aqui novamente!

Tentei adaptar a macro (botão) pra minha planilha real, mas esta dando um erro que já fiz alguns testes, mas não adianta, não conseguir resolver :-(

Você pode me ajudar, por favor?

O erro que esta dando é: "Unable to get the match property of the WorkSheet function class".

Segue arquivo: https://www.wetransfer.com/downloads/5761c0a9f792f0ba321978f3166d2fc820130910144610/b99c42

Muito obrigada mais uma vez.

Bjo

vinibpeixoto · 11 de setembro de 2013

Olá, danilima15,

O problema ocorria devido aos nomes dos canais. A rotina tentava procurar o valor abaixo.

"Cinemax"

No entanto, as planilhas continham apenas os valores abaixo (com todos os espaços).

"   CINEMAX                    "

Portanto, para resolver o problema, bastou adicionar um pequeno trecho de código antes das execuções da função MATCH.


'Remove os espaços das extremidades dos nomes dos canais
For Each celula In Worksheets(planilha.Name).Range("B4:B52").Cells
    celula.Value = Trim(celula.Value)
Next

Para corrigir o problema, substitua a rotina atual do botão pelo código abaixo, que inclui o trecho acima nos momentos necessários.


    Application.ScreenUpdating = False

    Dim canal As String
    'Solicita o canal em que deseja-se a extração da posição do ranking
    canal = InputBox("Qual o canal desejado?", "Canal", "Cinemax")
    canal = Trim(canal)

    'Define a primeira coluna da planilha Ranking, em que os dados
    'ordenados por audiência serão copiados (abaixo, coluna A - coluna número 1)
    Dim colunaAudiencia As Integer
    colunaAudiencia = 1

    'Realiza a mesma definição acima, mas para os dados ordenados por
    'afinidade (abaixo, coluna F - coluna número 6)
    Dim colunaAfinidade As Integer
    colunaAfinidade = 6

    'Define a primeira linha da planilha Ranking, em que os dados
    'ordenados serão copiados (abaixo, linha 5) - de acordo com as colunas
    'anteriores, os dados serão copiados a partir das células A5 e F5
    Dim linha As Integer
    linha = 5

    'Se nenhum canal foi informado, não faz nada
    If Len(canal) > 0 Then
        'Percorre todas as planilhas
        For Each planilha In ThisWorkbook.Sheets
            'Se não for a planilha Ranking, realiza a ordenação
            If planilha.Name <> "Ranking" Then
                'Ordena os dados entre as células B4 e D52,
                'de acordo com os dados da coluna C
                Worksheets(planilha.Name).Range("B4:D52").Sort _
                    Key1:=Worksheets(planilha.Name).Columns("C"), Order1:=xlDescending
                'Ordena os dados entre as células G4 e I52,
                'de acordo com os dados da coluna I
                Worksheets(planilha.Name).Range("G4:I52").Sort _
                    Key1:=Worksheets(planilha.Name).Columns("I"), Order1:=xlDescending

                'Remove os espaços das extremidades dos nomes dos canais
                For Each celula In Worksheets(planilha.Name).Range("B4:B52").Cells
                    celula.Value = Trim(celula.Value)
                Next

                'Simula a função CORRESP, para saber em qual linha o canal
                'procurado encontra-se - dentre os dados ordenados por
                'audiência
                Dim correspAudiencia As Double
                correspAudiencia = WorksheetFunction.Match(canal, _
                    Worksheets(planilha.Name).Range("B4:B52"), _
                    0)

                'Simula a função ÍNDICE, para saber a posição do ranking do
                'canal procurado e seus demais dados, através do número da
                'linha obtido anteriormende
                Dim posicaoAudiencia As Double
                Dim audienciaAudiencia As Double
                Dim afinidadeAudiencia As Double
                posicaoAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("A4:A52"), _
                    correspAudiencia)
                audienciaAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("C4:C52"), _
                    correspAudiencia)
                afinidadeAudiencia = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("D4:D52"), _
                    correspAudiencia)

                'Remove os espaços das extremidades dos nomes dos canais
                For Each celula In Worksheets(planilha.Name).Range("G4:G52").Cells
                    celula.Value = Trim(celula.Value)
                Next

                'Realiza o mesmo, mas para os dados ordenados por
                'afinidade
                Dim correspAfinidade As Double
                correspAfinidade = WorksheetFunction.Match(canal, _
                    Worksheets(planilha.Name).Range("G4:G52"), _
                    0)

                Dim posicaoAfinidade As Double
                Dim audienciaAfinidade As Double
                Dim afinidadeAfinidade As Double
                posicaoAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("F4:F52"), _
                    correspAfinidade)
                audienciaAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("H4:H52"), _
                    correspAfinidade)
                afinidadeAfinidade = WorksheetFunction.Index( _
                    Worksheets(planilha.Name).Range("I4:I52"), _
                    correspAfinidade)

                'Copia os dados para a planilha Ranking
                Cells(linha, colunaAudiencia).Value = planilha.Name 'Target
                Cells(linha, colunaAudiencia + 1).Value = posicaoAudiencia 'Posição
                Cells(linha, colunaAudiencia + 2).Value = audienciaAudiencia 'Audiência
                Cells(linha, colunaAudiencia + 3).Value = afinidadeAudiencia 'Afinidade

                Cells(linha, colunaAfinidade).Value = planilha.Name 'Target
                Cells(linha, colunaAfinidade + 1).Value = posicaoAfinidade 'Posição
                Cells(linha, colunaAfinidade + 2).Value = audienciaAfinidade 'Audiência
                Cells(linha, colunaAfinidade + 3).Value = afinidadeAfinidade 'Afinidade

                linha = linha + 1
            End If
        Next planilha
    End If

    Application.ScreenUpdating = True