Formatar tabela dinâmica Excel automaticamente

Atualizar todas as tabelas dinâmicas no Excel com VBA
Atualizar todas as tabelas dinâmicas no Excel com VBA
22 de fevereiro de 2015
Converter PDF para Excel - Able2Extract 9 download
Converter PDF para Excel – Able2Extract 9 download
12 de março de 2015

Objetivo: Formatar tabela dinâmica Excel automaticamente. VBA Excel.

Formatar tabela dinâmica automaticamente

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


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/

3 Comentários

  1. Joao Adolfo disse:

    Saravá! Preciso de uma tabela Excel automática que viabilize a montagem de um produto, que têm muitas peças. Trata-se de um painel metálico funcional, que contém várias lâminas articuladas em alumínio, são vários tamanhos, módulos padrão a serem escolhidos e adaptados ás necessidades solicitadas pelo cliente.No catalago técnico, existem várias tabelas com todas dimensões disponíveis: Longarinas, vigas, rufos, arremates, pingadeiras, chapa-extra, peças de ancoramento, cruzador, keme, rotula, sapatas, calço, parafusos, etc. Esses acessórios complementares serão acrescidos ao produto final.
    O ideal seria que na escolha do painel, apareça o croqui já na proporção de tamanho com todas as peças visíveis nessa imagem (tridimensional?), conjuntamente uma relação das peças contidas neste modulo, com os respectivos preços, desconto padrão, a soma total e condições de pagamento. Ao adicionar/retirar qualquer peça estrutural ou acessório á relação de peças, que o croqui e os custos sejam alterados automaticamente.
    Esse croqui tem que ser independente, para que possamos optar no envio ao cliente juntamente com o orçamento.
    Qual o nome deste sistema no Excel? Penso que são várias funções interdependentes. Como procurar e onde encontro uma tabela com esse procedimento?
    Grato. JA.

  2. kleyton disse:

    Como faço para Cria uma estrutura com Grupo, SubGrupo e Ativadade abaixo.

    4 CIVIL
    4.5 FECHAMENTOS PREDIAIS E INDUSTRIAIS
    4.5.5 FORNECIMENTO E EXECUÇÃO DE ALVENARIA DE VEDAÇÃO EM BLOCO DE CONCRETO ESPESSURA DE 20CM, COM FRISO METRO QUADRADO
    205 SERVENTE DE OBRAS HORA
    200 PEDREIRO HORA
    4 TIJOLO CERAMICO DE 30CM COM 8 FUROS UNIDADE
    1 AREIA;TIPO LAVADA;GRANULOMETRIA PEQUENA OU MEDIA;APLICACAO USO GERAL. METRO CUBICO
    5 CIMENTO CP32 KILOGRAMA
    225 CAL HIDRATADA (25kg) KILOGRAMA
    4.8 ESQUADRIAS E VIDROS
    4.8.24 FORNECIMENTO E INSTALAÇÃO DE FECHADURA PARA PORTAS INTERNAS UNIDADE
    201 CARPINTEIRO HORA
    205 SERVENTE DE OBRAS HORA
    31 FECHADURA MAÇANETAS PARA PORTAS INTERNA INOX UNIDADE

    ”””””””””””””””
    Hoje a estrurara vem assim:

    CodGrupo Grupo CodSubGrupo SubGrupo CodServiço Serviço Unidade
    4 CIVIL 4.6 REVESTIMENTOS 4.1.13 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 10,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.13 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 10,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.14 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 15,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.15 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 20,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.13 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 10,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.14 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 15,0 MPA. METRO CUBICO
    4 CIVIL 4.1 ESTRUTURAS DE CONCRETO 4.1.14 FORNECIMENTO, TRANSPORTE, APLICAÇÃO, ADENSAMENTO E CURA DE CONCRETO CONVENCIONAL EM ESTRUTURA DE FUNDAÇÃO FCK = 15,0 MPA. METRO CUBICO
    4 CIVIL 4.7 PISOS 4.7.9 FORNECIMENTO E ASSENTAMENTO DE REVESTIMENTO CERÂMICO PEI 4, INCLUSIVE REJUNTAMENTO METRO QUADRADO
    4 CIVIL 4.7 PISOS 4.7.10 FORNECIMENTO E ASSENTAMENTO DE REVESTIMENTO CERÂMICO PEI 5, INCLUSIVE REJUNTAMENTO METRO QUADRADO
    4 CIVIL 4.7 PISOS 4.7.3 FORNECIMENTO E APLICAÇÃO, EM PISO, DE ARGAMASSA DE CIMENTO E AREIA, PARA NIVELAMENTO, REGULARIZAÇÃO OU ENCHIMENTO – TRAÇO 1:3 METRO CUBICO
    4 CIVIL 4.7 PISOS 4.7.3 FORNECIMENTO E APLICAÇÃO, EM PISO, DE ARGAMASSA DE CIMENTO E AREIA, PARA NIVELAMENTO, REGULARIZAÇÃO OU ENCHIMENTO – TRAÇO 1:3 METRO CUBICO
    4 CIVIL 4.8 ESQUADRIAS E VIDROS 4.8.3 FORNECIMENTO E INSTALAÇÃO DE JANELA EM MADEIRA DE LEI, TIPO TABICÃO (VENEZIANA MÓVEL), COMPLETA (CORRENTE, PINO E FERRAGENS) METRO QUADRADO
    5 HIDRO-SANITÁRIAS 5.2 METAIS SANITÁRIOS 5.2.3 FORNECIMENTO E INSTALAÇÃO DE DUCHA HIGIÊNICA AQUAJET UNIDADE
    4 CIVIL 4.7 PISOS 4.7.3 FORNECIMENTO E APLICAÇÃO, EM PISO, DE ARGAMASSA DE CIMENTO E AREIA, PARA NIVELAMENTO, REGULARIZAÇÃO OU ENCHIMENTO – TRAÇO 1:3 METRO CUBICO
    4 CIVIL 4.8 ESQUADRIAS E VIDROS 4.8.3 FORNECIMENTO E INSTALAÇÃO DE JANELA EM MADEIRA DE LEI, TIPO TABICÃO (VENEZIANA MÓVEL), COMPLETA (CORRENTE, PINO E FERRAGENS) METRO QUADRADO
    6 ELÉTRICA 6.2 ILUMINAÇÃO 6.2.2 FORNECIMENTO E ASSENTAMENTO DE LUMINÁRIA DE SOBREPOR P/ LÂMPADA FLUORESCENTE 2X40W C/ REFLETOR DE ALUMÍNIO E ALETAS BRANCAS, MARCA LUMILUX MOD. LSR-A OU SIMILAR.
    6 ELÉTRICA 6.6 ENTRADA DE ENERGIA 6.3.2 FORNECIMENTO E INSTALAÇÃO DE QUADRO DE DISTRIBUIÇÃO DE CIRCUITOS-QDC,DE EMBUTIR OU SOBREPOR, EM CHAPA DE AÇO 16MSG, PORTA COM FECHO RÁPIDO, BARRAMENTOS 3F+N+T, ACABAMENTO EM EPÓXI NA COR CINZA – CONTENDO 32 CIRCUITOS UNIPOLARES (DIN) UNIDADE
    5 HIDRO-SANITÁRIAS 5.1 LOUÇAS SANITÁRIAS E ACESSÓRIOS 5.1.3 FORNECIMENTO E INSTALAÇÃO DE PIA INOX COM UMA CUBA UNIDADE

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.