Objetivo: Formatar tabela dinâmica Excel automaticamente. VBA Excel.
No dia-a-dia muitas vezes a tabela dinâmica resolve nossos problemas, sendo uma das ferramentas mais úteis que o Excel nos oferece.
Com ela podemos sumarizar os dados e apresentá-los das mais diversas formas e com várias opções, mas há sempre formatações que realizamos sempre que as criamos.
Um exemplo disto é a alteração do nome dos campos de valor inseridos, retirando o “Contagem de” e o “Soma de”, e além disso formatando para repetir os valores das listas e formatar os valores para que fiquem no formato de Número separado por ponto e com duas casas decimais. Tudo isso consome tempo.
Encontrei um código VBA no site chandoo.org, ao qual realizei algumas alterações, colocando em português e acrescentando outras formatações que achava interessante.
Este código realiza uma formatação padrão na sua tabela dinâmica, bastando para isso você criar sua tabela dinâmica e, selecionando uma das suas células, executar a macro.
Veja neste artigo como copiar os procedimentos acima e incluir na sua pasta pessoal de Macros neste artigo: http://guiadoexcel.com.br/habilitando-a-guia-desenvolvedor-e-copiando-procedimentos-vba-sub-da-internet
Veja neste outro artigo como criar botões de atalho para os procedimentos criados para que eles fiquem conforme abaixo: http://guiadoexcel.com.br/criar-botoes-de-atalho-para-macros-e-procedimento-vba.
Abaixo o código fonte devidamente comentado e com as alterações citadas acima:
Sub InstantPivot()
'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
'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
Set lo = ActiveCell.ListObject
If lo Is Nothing Then Set lo = ActiveSheet.ListObjects.Add(xlSrcRange, Selection.CurrentRegion, , xlYes)
Set rng = Cells(ActiveSheet.UsedRange.Row, ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column + 1)
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo)
Set pt = pc.CreatePivotTable(TableDestination:=rng)
Else:
'Verifica se o objeto pt é baseado em um ListObject.
' * Se for, definir como ListObject
' * Se não, retorna os dados para um ListObject
On Error Resume Next
Set lo = Range(pt.SourceData).ListObject
On Error GoTo errhandler
If lo Is Nothing Then
Set rng = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
Set wksSource = rng.Parent
Set lo = wksSource.ListObjects.Add(xlSrcRange, rng, , xlYes)
pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=lo.Name)
End If
End If
With pt
.ColumnGrand = True
.RowGrand = False
.RowAxisLayout xlTabularRow
.RepeatAllLabels xlRepeatLabels
.ShowTableStyleRowHeaders = False
.ShowDrillIndicators = False
.HasAutoFormat = False
.SaveData = False
.ManualUpdate = True
If ActiveCell.CurrentRegion.Cells.Count > 1 Then
For i = 1 To .PivotFields.Count - .DataFields.Count 'The .DataField.Count bit is just in case the pivot already exists
Set pf = .PivotFields(i)
With pf
If pf.Name "Values" Then
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
On Error Resume Next
.NumberFormat = lo.DataBodyRange.Cells(1, i).NumberFormat
On Error GoTo errhandler
End If
End With
Next i
End If
End With
' Obter DataFields para coincidir com a formatação do campo de origem
' Note-se que isso só vai ser necessárias no caso de que estamos
' executando este código em uma tabela dinâmica já existente
On Error GoTo errhandler
If pt.DataFields.Count > 0 Then
For Each pf In pt.DataFields
If pf.Function xlCount Then pf.NumberFormat = "#,##0.00" 'pt.PivotFields(pf.SourceName).NumberFormat
' Acabar com 'Soma de', se possível
On Error Resume Next
pf.Caption = pf.SourceName & " "
On Error GoTo errhandler
Next pf
End If
'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
'Tratamento de erros
Err.Clear
errhandler:
If Err.Number > 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
MsgBox "Atenção, ocorreu um erro: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End If
End If
End Sub
Abraço
Marcos Rieper
