jueves, 14 de diciembre de 2017

VBA: Subtotales y Repetir etiquetas en tabla dinámicas

Un lector pedía ayuda para mostrar ciertas opciones en su tabla dinámica:
1-Sin subtotales
2-En estilo de diseño Tabular
3-Repitiendo etiquetas de elementos
:
[...]En esta ocasión te deseo consultar que codigo utilizar para poner mi tabla dinamica de forma tabular, quitar los subtotales y repetir las etiquetas.[...]


Partimos de una tabla como origen de datos con cuatro campos: Fechas, Conceptos, Categorías e Importe,
a partir de la cual hemos construido una tabla dinámica con dos campos en el área de filas:
Conceptos, Categorías
y el campo de Importe en el área de valores resumido por suma.

VBA: Subtotales y Repetir etiquetas en tabla dinámicas



El aspecto de la tabla dinámica es que aparecen los subtotales por defecto, no se repiten las etiquetas de elementos y tiene un diseño Compacto.

Con la macro siguiente que incluimos en un módulo estándar de nuestro proyecto conseguiremos los tres puntos que requiere el lector:

Sub OpcionesTablaDinamica()
Dim PT As PivotTable
Dim PF As PivotField

On Error Resume Next
'Definimos el objeto Tabla dinámica sobre el que trabajar
Set PT = Application.ActiveSheet.PivotTables(1)
    'cambiamos a diseño Tabular
    PT.RowAxisLayout xlTabularRow
    'exigimos se repitan las etiquetas
    PT.RepeatAllLabels xlRepeatLabels
    'quitamos los subotales de todos los campos...
    For Each PF In PT.PivotFields
      PF.Subtotals(1) = True
      PF.Subtotals(1) = False
    Next PF
End Sub



El resultado tras ejecutar la macro es el esperado:

VBA: Subtotales y Repetir etiquetas en tabla dinámicas



Otra posibilidad para eliminar los subotales sobre un campo en concreto:

Sub OpcionesTablaDinamica()
Dim PT As PivotTable
Dim PF As PivotField

On Error Resume Next
Set PT = Application.ActiveSheet.PivotTables(1)
    PT.RowAxisLayout xlTabularRow
    PT.RepeatAllLabels xlRepeatLabels
    'quitamos el Subtotal solo del campo 'concepto'
    With PT.PivotFields("concepto")
        .Subtotals(1) = True
        .Subtotals(1) = False
    End With
End Sub

2 comentarios: