Objetivo: Como classificar uma tabela dinâmica automaticamente no Excel.
A tabela dinâmica no Excel é uma poderosa ferramenta de análise.
Com ela o usuário pode unir grandes massas de dados, criando os seus próprios relatórios com os campos desta base, inclusive criando cálculos. Tudo muito rápido e prático.
No entanto uma das funcionalidades desta ferramenta não é muito prática. A classificação de dados nas tabelas dinâmicas podem ser bastante trabalhosas, principalmente quando se trata de valores.
Para se classificar os dados em uma tabela dinâmica, basta você clicar no botão sobre a coluna e clicar em classificar:
O problema consiste em quando queremos que a tabela dinâmica seja organizada por um determinado campo e este não é o primeiro campo, sendo necessário que todos os campos sejam classificados por este. Para isto deve-se clicar em uma coluna e clicar no botão de classificação e na opção Mais Opções de Classificação, selecionar se será classificado de forma crescente ou decrescente e o campo.
Esta operação tem que ser repetida para todos os campos da esquerda para a direita até o campo definido. O que gera um grande trabalho.
Os códigos VBA Excel criados abaixo realizam a classificação de forma crescente ou de forma decrescente, bastando clicar no título da coluna da tabela Excel e clicar no botão Classificar.
Para utilizar o código siga o passo-a-passo deste artigo: Habilitar a guia desenvolvedor no Excel e copiar códigos VBA da internet.
Sub lsClassificarTabelaDinamicaMaiorMenor()
'Baseado no site chandoo.org
' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz
'Formata a tabela dinâmica com sua formatação preferida, formatação default
'Configurações realizadas
' 1. Mostrar de forma tabulada os dados
' 2. Ligar a opção de repetir linhas
' 3. Desliga os subtotais
' 4. Liga o total final de coluna
' 5. Desliga a opção de ajustar a tabela dinâmica
' 7. Desliga a opção de salvar os dados da tabela dinâmica como arquivo
' 8. Formata os campos de soma de valor no formato decimal separado por ponto
' 9. Ajusta as colunas da tabela dinâmica
' 10. Retira do nome dos valores as descrições Contagem, Soma
Dim pc As PivotCache
Dim pf As PivotField
Dim pt As PivotTable
Dim lo As ListObject
Dim rng As Range
Dim strLabel As String
Dim strFormat As String
Dim i As Long
Dim wksSource As Worksheet
Dim lRange As String
'Verifica se estamos lidando com uma versão do Excel que suporta ListObjects
'Versões superiores ao Excel 2007
If Application.Version >= 14 Then
On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo errhandler
If pt Is Nothing Then
MsgBox "Selecione o campo da tabela dinâmica pelo qual quer classificar!"
GoTo errhandler
End If
pt.PivotCache.Refresh
lCampo = pt.PivotFields(ActiveCell.Value).Name
lRange = ActiveCell.Address
'Limpa a classificação da tabela
With pt
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = 1 To .PivotFields.Count - .DataFields.Count
Set pf = .PivotFields(i)
With pf
.AutoSort xlManual, pf.SourceName
On Error Resume Next
On Error GoTo errhandler
End With
Next i
End If
End With
'Classifica a tabela pelo campo desejado
With pt
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = .PivotFields.Count - .DataFields.Count - 1 To 1 Step -1
Set pf = .PivotFields(i)
With pf
If pf.Name <> "Values" Then
.AutoSort xlDescending, lCampo
On Error Resume Next
On Error GoTo errhandler
End If
End With
Next i
End If
End With
'Calcula e atualiza a tela
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
With pt
.ManualUpdate = False
.TableRange2.Select
End With
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
ActiveCell.CurrentRegion.EntireColumn.AutoFit
Range(lRange).Select
'Tratamento de erros
Err.Clear
errhandler:
If Err.Number > 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
If Err.Number = 1004 Then
MsgBox "Selecione o cabeçalho do campo da tabela dinâmica que quer classificar!"
Else
MsgBox "Atenção, ocorreu um erro: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End If
End If
End If
End Sub
Sub lsClassificarTabelaDinamicaMenorMaior()
'Baseado no site chandoo.org
' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz
'Formata a tabela dinâmica com sua formatação preferida, formatação default
'Configurações realizadas
' 1. Mostrar de forma tabulada os dados
' 2. Ligar a opção de repetir linhas
' 3. Desliga os subtotais
' 4. Liga o total final de coluna
' 5. Desliga a opção de ajustar a tabela dinâmica
' 7. Desliga a opção de salvar os dados da tabela dinâmica como arquivo
' 8. Formata os campos de soma de valor no formato decimal separado por ponto
' 9. Ajusta as colunas da tabela dinâmica
' 10. Retira do nome dos valores as descrições Contagem, Soma
Dim pc As PivotCache
Dim pf As PivotField
Dim pt As PivotTable
Dim lo As ListObject
Dim rng As Range
Dim strLabel As String
Dim strFormat As String
Dim i As Long
Dim wksSource As Worksheet
Dim lRange As String
'Verifica se estamos lidando com uma versão do Excel que suporta ListObjects
'Versões superiores ao Excel 2007
If Application.Version >= 14 Then
On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo errhandler
If pt Is Nothing Then
MsgBox "Selecione o campo da tabela dinâmica pelo qual quer classificar!"
GoTo errhandler
End If
pt.PivotCache.Refresh
lCampo = pt.PivotFields(ActiveCell.Value).Name
lRange = ActiveCell.Address
'Limpa a classificação da tabela
With pt
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = 1 To .PivotFields.Count - .DataFields.Count
Set pf = .PivotFields(i)
With pf
.AutoSort xlManual, pf.SourceName
On Error Resume Next
On Error GoTo errhandler
End With
Next i
End If
End With
'Classifica a tabela pelo campo desejado
With pt
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = .PivotFields.Count - .DataFields.Count - 1 To 1 Step -1
Set pf = .PivotFields(i)
With pf
If pf.Name "Values" Then
.AutoSort xlAscending, lCampo
On Error Resume Next
On Error GoTo errhandler
End If
End With
Next i
End If
End With
'Calcula e atualiza a tela
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
With pt
.ManualUpdate = False
.TableRange2.Select
End With
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
ActiveCell.CurrentRegion.EntireColumn.AutoFit
Range(lRange).Select
'Tratamento de erros
Err.Clear
errhandler:
If Err.Number > 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
If Err.Number = 1004 Then
MsgBox "Selecione o cabeçalho do campo da tabela dinâmica que quer classificar!"
Else
MsgBox "Atenção, ocorreu um erro: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End If
End If
End If
End Sub
Abraço
Marcos Rieper
Curso Excel Completo – Do Básico ao VBA
Quer aprender Excel do Básico, passando pela Avançado e chegando no VBA? Clique na imagem abaixo:
