Ir ao conteúdo
  • Cadastre-se
danilima15

[Resolvido] Excel - Macro (Classificar e Extrair)

Recommended Posts

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

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.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Vini,

Agora funcionou perfeitamente, eu jamais identificaria que o erro que estava dando era por causa dos espaços.

Muitíssimo obrigada mesmo, vai ajudar muito no meu dia a dia.

Beijo:lol::lol::lol::lol::lol::lol:

Compartilhar este post


Link para o post
Compartilhar em outros sites

Caso o autor necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.

Compartilhar este post


Link para o post
Compartilhar em outros sites
Visitante
Este tópico está impedido de receber novos posts.





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

×