Tablas Dinamicas (Pivot tables)-Filtros Excel

Escrito por Hector Miguel. Publicado en Excel XP/2003/2007 Visto: 3560

Microsoft Most Valuable Professional

Tablas dinamicas - filtros

Pivot Tables

by Héctor Miguel Orozco Díaz

Las tablas dinámicas son tablas que no tienen un tamaño establecido. Una de las herramientas más potente de otras muchas que Excel posee. Resume grandes cantidades de datos de una manera rápida en cuestión de segundos....

En el artículo de hoy, os vamos a mostrar como podéis obtener la información desglosada de la celda activa de una tabla dinámica:

Desarrollo del archivo de Excel (Hoja Base de datos) -(Hoja tabla dinámica)

Desarrollo del Código (Versión Extendida)-(Versión Recortada)

"Detalle" con la versión 2007 de office/excel

Enlaces de Interés

Desarrollo

(Hoja Base de datos) -(Hoja tabla dinámica)

Para obtener la información desglosada de la celda activa de una tabla dinámica:

Nos situamos en una celda de nuestra Tabla dinámica y un doble-click de ratón sobre dicha celda >>

Excel genera una hoja adicional con la información filtrada de dicha celda a la cual hemos hecho doble-click >>

Contras que tenemos con dicha operación:

Por cada desglose de datos que apliquemos, Excel llenara de nuevas hojas nuestro archivo corremos el riesgo de "saturarnos" en Excel con cada una de las hojas que se crean por cada desglose que realicemos.

Nota: El ejemplo aquí expuesto, está preparado (por lo pronto) solo para datos/lista/... en la misma hoja o en otra del mismo libro (se puede adaptar) podría ser adaptado (p.e.) en algun "commandbar.popup" o al evento '_beforedoubleclick' (en sustitución de la generación de hojas).

OJO: habría que "condicionar" la ejecución si algún campo de página está configurado para selecciones múltiples (solo versión 2007) y/o si la tabla tiene como origen datos/listas/... de Excel, PERO con rangos de consolidación múltiple.

Solución a los contras de la operación anterior ¿ Cómo NO saturarnos de hojas nuevas ? :

Aplicar autofiltros al listado de origen de la tabla (siempre y cuando el listado este en una hoja de Excel). Funcionalidad o característica que (aun en la versión 2007) no ha sido agregada al Excel.

Tenemos nuestro Origen datos/lista en una hoja de Excel llamémosla [ Base de datos ] >>

Nos situamos en una celda de nuestra Tabla dinámica >>

Realizar el filtro en la hoja Origen Datos

Le damos a las teclas [ Alt + F8 ] para ver la ventana de diálogo Macro >>

Click en el botón Ejecutar y nos vamos a nuestra hoja [ Base de datos ]

Autofiltro datos Origen de tabla dinamica

Ya tenemos filtrada Nuestra Base de datos [ Origen datos/lista ] sin necesidad de Hojas adicionales, para un mayor rendimiento de nuestra aplicación Excel

Desarrollo Código

(Versión Extendida)-(Versión Recortada)

Al final del artículo se incluye el código en dos versiones (en realidad es el mismo, solo en más o menos líneas, según costumbres de "lectura" del código)

La primera (versión extendida) se lleva 220 líneas de código (se puede extender +/- a 250 si se declaran las variables (Dim) en una línea cada una)

La segunda (versión recortada) solo usa 80 líneas de código

Podéis elegir la que más os guste PERO NO las dos Versiones juntas...

Copy-paste de UNA de las dos versiones en un Módulo Estándar, desde VB de Excel -> menú Insertar -> Módulo >>

El método utilizado está basado en determinar en cuál de las (9) "zonas" de una tabla dinámica esta la "celda activa"
para esto se utilizan (9) variables de tipo "Range" para determinar la zonas y encontrar en cuál de ellas esta "la celda"

zona → variable → detalles de ubicación:

"dónde está la celda activa?" (todas dentro del área de datos)

zona 1 → CeldasD → en el área de datos pero NO en (sub)totales de fila/columna
zona 2 → CeldasPC → en alguna columna de subtotales
zona 3 → CeldasPF → en alguna fila de subtotales
zona 4 → CeldasPX → en algún "cruce" de subtotales
zona 5 → CeldasTC → en alguna fila de alguna columna de totales
zona 6 → CeldasTF → en alguna columna de alguna fila de totales
zona 7 → CeldasTCX → en algún "cruce" en la columna de totales
zona 8 → CeldasTFX → en algún "cruce" en la fila de totales
zona 9 →(sin variable)→ en la celda de totales generales de la TD

Hay otras variables de tipo "Range" utilizadas para preparar "la realidad" de la variable "CeldasD", para lo cual...
se define una función personalizada (Slice) para separar (o "divorciar") rangos (lo contrario de la función Unión)
esto para determinar con claridad que la variable "CeldasD" (zona 1) NO incluya filas/columnas con (sub)totales

→ El nombre del procedimiento es +/- "explicito":

CeldaTDFiltraDatosOrigenExcel

Detalle con la versión 2007 de office/excel

Surgió un "detalle" con la versión 2007 de office/excel en relación con los campos de página en las tablas dinámicas:

Cuando algún campo de página esta "filtrando" por cualquiera de sus pivotitems, se puede restablecer a no-filtrando asignando a su propiedad ".CurrentPage" el valor = "(All)" => en inglés <= y Excel se encarga de ponerlo en el idioma instalado.

OJO: La asignación de este valor usando la expresión inglés => "(All)" <= es válido para cualquier idioma (versiones 97 a 2007) incluso, si la versión es (p.e.) en español, puedes establecer su valor a: =("Todas").

PERO... si la versión es (2007) NO es en inglés, NO PUEDES "preguntar" a vba si el campo de pagina (NO filtrando) es = / <> "(All)" se tiene que preguntarle en el idioma "local" (para el caso de español la pregunta debe ser si es = / <> "(Todas)" lo que obligo a recurrir a un bucle comparando cada pivotitem del campo de página con el ":CurrentPage" (que mejor ni os cuento)

Descarga de Archivo para pruebas

icon Tablas y autofiltros (46.5 kB)>>

Enlaces de Interés

Excel -- Pivot Tables -- Filter Source Data

Debra Dalgleish

http://www.contextures.com/xlPivot-Filter-Source-Data...

Gráficos e Informes Tablas Dinámicas

http://office.microsoft.com/es-es/excel/CH010714013082.aspx

Tablas Dinámicas Excel

http://office.microsoft.com/es-es/excel/tablas dinamicas

Código

(Versión Extendida)

' === función general para "divorciar" rangos (lo contrario de Unión) ==

Private Function Slice(Excluir As Range, DeDonde As Range) As Range
Dim Celda As Range
For Each Celda In DeDonde
If Intersect(Celda, Excluir) Is Nothing Then
Set Slice = Union(IIf(Slice Is Nothing, Celda, Slice), Celda)
End If
Next
End Function

' === mejorado para 2007 ===

Sub CeldaTDFiltraDatosOrigenExcel()
Application.ScreenUpdating = False
With ActiveSheet
If .PivotTables.Count = 0 Then
Exit Sub
Else
Dim TD As Byte, Continuar As Boolean, FLR As String
End If
For TD = 1 To .PivotTables.Count
If Not Intersect(ActiveCell, .PivotTables(TD).DataBodyRange) Is Nothing Then
Continuar = True
Exit For
End If
Next
If Not Continuar Then
Exit Sub
Else
FLR = Application.International(xlUpperCaseRowLetter)
End If
Dim Origen As String, Hoja As String, Rango As String, Titulos As String, cpFiltro As String
Dim Parciales As Byte, Totales As Byte, Zona As Byte, _
Sig As Integer, Sig2 As Integer, cPag As Integer, cCol As Integer, cLab As Integer, _
cFila As Integer, cDatos As Integer, nFilas As Integer, nCols As Integer
Dim Campo As PivotField, ColsD As Range, ColsP As Range, FilasF As Range, FilasD As Range, _
Celda As Range, CeldasD As Range, CeldasPC As Range, CeldasPF As Range, CeldasPX As Range, _
CeldasTC As Range, CeldasTF As Range, CeldasTCX As Range, CeldasTFX As Range
With .PivotTables(TD)
Origen = .PivotCache.SourceData
Hoja = IIf(InStr(Origen, "!") > 0, Application.Substitute(Left(Origen, InStr(Origen, "!") - 1), "'", ""), .Parent.Name)
With Application
Rango = .ConvertFormula(.Substitute(Mid(Origen, InStr(Origen, "!") + 1), FLR, "R"), xlR1C1, xlA1)
End With
Titulos = Range(Rango).Resize(1).Address
cPag = .PageFields.Count
cCol = .ColumnFields.Count
cLab = .DataLabelRange.Columns.Count
cFila = .RowFields.Count - cLab
cDatos = .DataFields.Count
If cFila > 1 Then
Parciales = 1
End If
If cCol > 1 Then
Parciales = Parciales + 2
End If
If .RowGrand Then
Totales = 1
End If
If .ColumnGrand Then
Totales = Totales + 2
End If
With .ColumnRange
For Each Celda In .Offset(.Rows.Count - 1).Resize(1, .Columns.Count + (Totales > 1))
If Application.CountIf(Worksheets(Hoja).Range(Rango), Celda) > 0 Then
Set ColsD = Union(IIf(ColsD Is Nothing, Celda, ColsD), Celda)
Else
Set ColsP = Union(IIf(ColsP Is Nothing, Celda, ColsP), Celda)
End If
Next
End With
For Each Campo In .DataFields
Set FilasD = Union(Campo.DataRange.EntireRow, IIf(FilasD Is Nothing, Campo.DataRange.EntireRow, FilasD))
Next
With .RowRange
Set FilasF = Intersect(FilasD, .Resize(, .Columns.Count - cLab))
End With
Set CeldasD = Intersect(FilasD, ColsD.EntireColumn)
If Parciales > 1 Then
Set CeldasPC = Intersect(FilasD, ColsP.EntireColumn)
End If
With .DataBodyRange.Resize(.DataBodyRange.Rows.Count + ((Totales \ 2 = 1) * cDatos))
If Parciales \ 2 = 1 Then
Set CeldasPF = Slice(CeldasD, Intersect(.EntireRow, ColsD.EntireColumn))
End If
If Parciales = 3 Then
Set CeldasPX = Slice(CeldasPC, Intersect(.EntireRow, ColsP.EntireColumn))
End If
End With
If Totales > 1 Then
Set CeldasTC = Intersect(FilasD, .ColumnRange.Offset( _
.ColumnRange.Rows.Count - 1, .ColumnRange.Columns.Count - 1).Resize(1, 1).EntireColumn)
End If
If Totales \ 2 = 1 Then
Set CeldasTF = Intersect(.DataBodyRange.Offset( _
.DataBodyRange.Rows.Count - cDatos).Resize(cDatos), ColsD.EntireColumn)
End If
If Totales = 3 Then
If Not CeldasPF Is Nothing Then
Set CeldasTCX = Intersect(CeldasPF.EntireRow, CeldasTC.EntireColumn)
End If
If Not CeldasPC Is Nothing Then
Set CeldasTFX = Intersect(CeldasTF.EntireRow, CeldasPC.EntireColumn)
End If
End If
If Not Intersect(ActiveCell, CeldasD) Is Nothing Then
Zona = 1
End If
If Not CeldasPC Is Nothing Then
If Not Intersect(ActiveCell, CeldasPC) Is Nothing Then
Zona = 2
End If
End If
If Not CeldasPF Is Nothing Then
If Not Intersect(ActiveCell, CeldasPF) Is Nothing Then
Zona = 3
End If
End If
If Not CeldasPX Is Nothing Then
If Not Intersect(ActiveCell, CeldasPX) Is Nothing Then
Zona = 4
End If
End If
If Not CeldasTC Is Nothing Then
If Not Intersect(ActiveCell, CeldasTC) Is Nothing Then
Zona = 5
End If
End If
If Not CeldasTF Is Nothing Then
If Not Intersect(ActiveCell, CeldasTF) Is Nothing Then
Zona = 6
End If
End If
If Not CeldasTCX Is Nothing Then
If Not Intersect(ActiveCell, CeldasTCX) Is Nothing Then
Zona = 7
End If
End If
If Not CeldasTFX Is Nothing Then
If Not Intersect(ActiveCell, CeldasTFX) Is Nothing Then
Zona = 8
End If
End If
If Not CeldasTF Is Nothing And Not CeldasTC Is Nothing Then
If Not Intersect(ActiveCell, CeldasTF.EntireRow, CeldasTC.EntireColumn) Is Nothing Then
MsgBox "La celda activa se encuentra al final de la TD !!!"
GoTo Salida ' Zona = 9 '
End If
End If
If Worksheets(Hoja).AutoFilterMode Then
Worksheets(Hoja).AutoFilterMode = False
End If
If cPag = 0 Then
GoTo SinPaginas
End If
For Sig = 1 To cPag
With .PageFields(Sig)
cpFiltro = .CurrentPage
If Val(Application.Version) < 12 Then
GoTo OmitirBucle
Else
cpFiltro = "(All)"
End If
For Sig2 = 1 To .PivotItems.Count
If .CurrentPage = .PivotItems(Sig2) Then
cpFiltro = .PivotItems(Sig2)
Exit For
End If
Next
OmitirBucle:
If cpFiltro <> "(All)" Then
Worksheets(Hoja).Range(Rango).AutoFilter _
Field:=Application.Match(.Name, Worksheets(Hoja).Range(Titulos), 0), _
Criteria1:=CStr(cpFiltro)
End If
End With
Next
SinPaginas:
Select Case Zona
Case 1, 2, 5
nFilas = cFila
End Select
Select Case Zona
Case 1, 3, 6
nCols = cCol
End Select
Select Case Zona
Case 3, 4, 7
nFilas = cFila - 1
End Select
Select Case Zona
Case 2, 4, 8
nCols = cCol - 1
End Select
For Sig = 1 To nFilas
With Cells(ActiveCell.Row, .RowRange.Cells(1).Column).Offset(, -1 + Sig)
Worksheets(Hoja).Range(Rango).AutoFilter _
Field:=Application.Match(.PivotField.Name, Worksheets(Hoja).Range(Titulos), 0), _
Criteria1:=.PivotItem.Name
End With
Next
For Sig = 1 To nCols
With Cells(.ColumnRange.Cells(1).Row, ActiveCell.Column).Offset(Sig)
Worksheets(Hoja).Range(Rango).AutoFilter _
Field:=Application.Match(.PivotField.Name, Worksheets(Hoja).Range(Titulos), 0), _
Criteria1:=.PivotItem.Name
End With
Next
End With
End With
Salida:
Set CeldasTFX = Nothing
Set CeldasTCX = Nothing
Set CeldasTF = Nothing
Set CeldasTC = Nothing
Set CeldasPX = Nothing
Set CeldasPF = Nothing
Set CeldasPC = Nothing
Set CeldasD = Nothing
Set FilasD = Nothing
Set FilasF = Nothing
Set ColsP = Nothing
Set ColsD = Nothing
End Sub

(Versión Recortada)

 ' op2: version recortada

    ' === funcion general para "divorciar" rangos (lo contrario de Union) ==

    Private Function Slice(Excluir As Range, DeDonde As Range) As Range
    Dim Celda As Range
    For Each Celda In DeDonde
    If Intersect(Celda, Excluir) Is Nothing Then
    Set Slice = Union(IIf(Slice Is Nothing, Celda, Slice), Celda)
    End If
    Next
    End Function



    ' === mejorado para 2007 ===


    Sub CeldaTDFiltraDatosOrigenExcel(): Application.ScreenUpdating = False
    With ActiveSheet: If .PivotTables.Count = 0 Then Exit Sub Else Dim TD As Byte, Continuar As Boolean, FLR As String
    For TD = 1 To .PivotTables.Count
    If Not Intersect(ActiveCell, .PivotTables(TD).DataBodyRange) Is Nothing Then Continuar = True: Exit For
    Next: If Not Continuar Then Exit Sub Else FLR = Application.International(xlUpperCaseRowLetter)
    Dim Origen As String, Hoja As String, Rango As String, Titulos As String, cpFiltro As String
    Dim Parciales As Byte, Totales As Byte, Zona As Byte, Sig As Integer, Sig2 As Integer, _
    cPag As Integer, cCol As Integer, cLab As Integer, cFila As Integer, cDatos As Integer, nFilas As Integer, nCols As Integer
    Dim Campo As PivotField, ColsD As Range, ColsP As Range, FilasF As Range, FilasD As Range, _
    Celda As Range, CeldasD As Range, CeldasPC As Range, CeldasPF As Range, CeldasPX As Range, _
    CeldasTC As Range, CeldasTF As Range, CeldasTCX As Range, CeldasTFX As Range
    With .PivotTables(TD): Origen = .PivotCache.SourceData
    Hoja = IIf(InStr(Origen, "!") > 0, Application.Substitute(Left(Origen, InStr(Origen, "!") - 1), "'", ""), .Parent.Name)
    With Application: Rango = .ConvertFormula(.Substitute(Mid(Origen, InStr(Origen, "!") + 1), FLR, "R"), xlR1C1, xlA1): End With
    Titulos = Range(Rango).Resize(1).Address: cPag = .PageFields.Count: cCol = .ColumnFields.Count
    cLab = .DataLabelRange.Columns.Count: cFila = .RowFields.Count - cLab: cDatos = .DataFields.Count
    If cFila > 1 Then Parciales = 1
    If cCol > 1 Then Parciales = Parciales + 2
    If .RowGrand Then Totales = 1
    If .ColumnGrand Then Totales = Totales + 2
    With .ColumnRange: For Each Celda In .Offset(.Rows.Count - 1).Resize(1, .Columns.Count + (Totales > 1))
    If Application.CountIf(Worksheets(Hoja).Range(Rango), Celda) > 0 Then Set ColsD = _
    Union(IIf(ColsD Is Nothing, Celda, ColsD), Celda) Else Set ColsP = Union(IIf(ColsP Is Nothing, Celda, ColsP), Celda)
    Next: End With
    For Each Campo In .DataFields: Set FilasD = Union(Campo.DataRange.EntireRow, IIf(FilasD Is Nothing, Campo.DataRange.EntireRow, FilasD)): Next
    With .RowRange: Set FilasF = Intersect(FilasD, .Resize(, .Columns.Count - cLab)): End With: Set CeldasD = Intersect(FilasD, ColsD.EntireColumn)
    If Parciales > 1 Then Set CeldasPC = Intersect(FilasD, ColsP.EntireColumn)
    With .DataBodyRange.Resize(.DataBodyRange.Rows.Count + ((Totales \ 2 = 1) * cDatos))
    If Parciales \ 2 = 1 Then Set CeldasPF = Slice(CeldasD, Intersect(.EntireRow, ColsD.EntireColumn))
    If Parciales = 3 Then Set CeldasPX = Slice(CeldasPC, Intersect(.EntireRow, ColsP.EntireColumn))
    End With
    If Totales > 1 Then Set CeldasTC = Intersect(FilasD, .ColumnRange.Offset(.ColumnRange.Rows.Count - 1, .ColumnRange.Columns.Count - 1).Resize(1, 1).EntireColumn)
    If Totales \ 2 = 1 Then Set CeldasTF = Intersect(.DataBodyRange.Offset(.DataBodyRange.Rows.Count - cDatos).Resize(cDatos), ColsD.EntireColumn)
    If Totales = 3 Then If Not CeldasPF Is Nothing Then Set CeldasTCX = Intersect(CeldasPF.EntireRow, CeldasTC.EntireColumn)
    If Totales = 3 Then If Not CeldasPC Is Nothing Then Set CeldasTFX = Intersect(CeldasTF.EntireRow, CeldasPC.EntireColumn)
    If Not Intersect(ActiveCell, CeldasD) Is Nothing Then Zona = 1
    If Not CeldasPC Is Nothing Then If Not Intersect(ActiveCell, CeldasPC) Is Nothing Then Zona = 2
    If Not CeldasPF Is Nothing Then If Not Intersect(ActiveCell, CeldasPF) Is Nothing Then Zona = 3
    If Not CeldasPX Is Nothing Then If Not Intersect(ActiveCell, CeldasPX) Is Nothing Then Zona = 4
    If Not CeldasTC Is Nothing Then If Not Intersect(ActiveCell, CeldasTC) Is Nothing Then Zona = 5
    If Not CeldasTF Is Nothing Then If Not Intersect(ActiveCell, CeldasTF) Is Nothing Then Zona = 6
    If Not CeldasTCX Is Nothing Then If Not Intersect(ActiveCell, CeldasTCX) Is Nothing Then Zona = 7
    If Not CeldasTFX Is Nothing Then If Not Intersect(ActiveCell, CeldasTFX) Is Nothing Then Zona = 8
    If Not CeldasTF Is Nothing And Not CeldasTC Is Nothing _
    Then If Not Intersect(ActiveCell, CeldasTF.EntireRow, CeldasTC.EntireColumn) Is Nothing _
    Then MsgBox "La celda activa se encuentra al final de la TD !!!": GoTo Salida ' Zona = 9 '
    If Worksheets(Hoja).AutoFilterMode Then Worksheets(Hoja).AutoFilterMode = False
    If cPag = 0 Then GoTo SinPaginas
    For Sig = 1 To cPag: With .PageFields(Sig): cpFiltro = .CurrentPage
    If Val(Application.Version) < 12 Then GoTo OmitirBucle Else cpFiltro = "(All)"
    For Sig2 = 1 To .PivotItems.Count
    If .CurrentPage = .PivotItems(Sig2) Then cpFiltro = .PivotItems(Sig2): Exit For
    Next
OmitirBucle:
    If cpFiltro <> "(All)" Then Worksheets(Hoja).Range(Rango).AutoFilter Field:= _
    Application.Match(.Name, Worksheets(Hoja).Range(Titulos), 0), Criteria1:=CStr(cpFiltro)
    End With: Next
SinPaginas:
    Select Case Zona: Case 1, 2, 5: nFilas = cFila: End Select: Select Case Zona: Case 1, 3, 6: nCols = cCol: End Select
    Select Case Zona: Case 3, 4, 7: nFilas = cFila - 1: End Select: Select Case Zona: Case 2, 4, 8: nCols = cCol - 1: End Select
    For Sig = 1 To nFilas: With Cells(ActiveCell.Row, .RowRange.Cells(1).Column).Offset(, -1 + Sig)
    Worksheets(Hoja).Range(Rango).AutoFilter Field:= _
    Application.Match(.PivotField.Name, Worksheets(Hoja).Range(Titulos), 0), Criteria1:=.PivotItem.Name
    End With: Next
    For Sig = 1 To nCols: With Cells(.ColumnRange.Cells(1).Row, ActiveCell.Column).Offset(Sig)
    Worksheets(Hoja).Range(Rango).AutoFilter Field:= _
    Application.Match(.PivotField.Name, Worksheets(Hoja).Range(Titulos), 0), Criteria1:=.PivotItem.Name
    End With: Next: End With: End With
Salida:
    Set CeldasTFX = Nothing: Set CeldasTCX = Nothing: Set CeldasTF = Nothing: Set CeldasTC = Nothing
    Set CeldasPX = Nothing: Set CeldasPF = Nothing: Set CeldasPC = Nothing: Set CeldasD = Nothing
    Set FilasD = Nothing: Set FilasF = Nothing: Set ColsP = Nothing: Set ColsD = Nothing
    End Sub

Office Full

Pivot Tables

Desarrollo

(Hoja Base de datos) -(Hoja tabla dinámica)

Desarrollo Código

Detalle con la versión 2007 de office/excel

Descarga de Archivo para pruebas

Enlaces de Interés

Código

(Versión Extendida)

(Versión Recortada)