Officefull.es

Excel, word, powerpoint, android

Tablas Dinamicas (Pivot tables)-Filtros Excel febrero 6, 2009

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.

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 algún 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

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 ]

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 incluyafilas/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

 Tablas y autofiltros (13.1 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  
Categorías: Sin categoría

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *