2012-06-17 81 views
6

He intentado copiar y pegar soluciones de Internet desde siempre para intentar filtrar una tabla dinámica en Excel utilizando VBA. El código a continuación no funciona.Filtrar tabla dinámica de Excel utilizando VBA

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = "K123223" 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
End Sub 

Quiero filtrar para ver todas las filas que tienen SavedFamilyCode K123223. No quiero ver ninguna otra fila en la tabla dinámica. Quiero que esto funcione independientemente de los filtros anteriores. Espero me puedas ayudar con esto. ¡Gracias!


en base a su puesto que estoy tratando:

Sub FilterPivotField() 
    Dim Field As PivotField 
    Field = ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode") 
    Value = Range("$A$2") 
    Application.ScreenUpdating = False 
    With Field 
     If .Orientation = xlPageField Then 
      .CurrentPage = Value 
     ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then 
      Dim i As Long 
      On Error Resume Next ' Needed to avoid getting errors when manipulating fields that were deleted from the data source. 
      ' Set first item to Visible to avoid getting no visible items while working 
      .PivotItems(1).Visible = True 
      For i = 2 To Field.PivotItems.Count 
       If .PivotItems(i).Name = Value Then _ 
        .PivotItems(i).Visible = True Else _ 
        .PivotItems(i).Visible = False 
      Next i 
      If .PivotItems(1).Name = Value Then _ 
       .PivotItems(1).Visible = True Else _ 
       .PivotItems(1).Visible = False 
     End If 
    End With 
    Application.ScreenUpdating = True 
End Sub 

error en tiempo de desgracia, arrollados 91: Variable de objeto de bloque variable o con no establecido. ¿Qué ha causado este error?

+2

¿Has intentado grabar una macro? –

+0

me sale algo en la línea de Sub FilterPivotTable() Con ActiveSheet.PivotTables ("PivotTable2"). PivotFields ("") SavedFamilyCode .PivotItems ("K010"). Visible = True .PivotItems ("K012") .Visible = False End With End Sub Pero quiero que todos, excepto K010 de hacerse invisible La grabadora de macros ignora mis seleccionar/deseleccionar todos los clics – user1283776

Respuesta

2

Configurar la tabla dinámica para que sea así:

enter image description here

su código simplemente puede trabajar en rango ("B1") de vez en la tabla dinámica se filtrarán a que requieren SavedFamilyCode

Sub FilterPivotTable() 
Application.ScreenUpdating = False 
    ActiveSheet.Range("B1") = "K123224" 
Application.ScreenUpdating = True 
End Sub 
5

Field.CurrentPage solo funciona para los campos de filtro (también llamados campos de página).
Si desea filtrar un campo de fila/columna, que tienen que desplazarse a través de los elementos individuales, así:

Sub FilterPivotField(Field As PivotField, Value) 
    Application.ScreenUpdating = False 
    With Field 
     If .Orientation = xlPageField Then 
      .CurrentPage = Value 
     ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then 
      Dim i As Long 
      On Error Resume Next ' Needed to avoid getting errors when manipulating PivotItems that were deleted from the data source. 
      ' Set first item to Visible to avoid getting no visible items while working 
      .PivotItems(1).Visible = True 
      For i = 2 To Field.PivotItems.Count 
       If .PivotItems(i).Name = Value Then _ 
        .PivotItems(i).Visible = True Else _ 
        .PivotItems(i).Visible = False 
      Next i 
      If .PivotItems(1).Name = Value Then _ 
       .PivotItems(1).Visible = True Else _ 
       .PivotItems(1).Visible = False 
     End If 
    End With 
    Application.ScreenUpdating = True 
End Sub 

Entonces, usted acaba de llamar:

FilterPivotField ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode"), "K123223" 

Naturalmente, esto se vuelve más lento cuanto más elementos individuales hay en el campo. También puede usar SourceName en lugar de Name si se adapta mejor a sus necesidades.

+0

En respuesta a @ user1283776 (mejor un año tarde que nunca) - probablemente estés recibiendo el error porque deberías usar 'Establecer campo = ...' – savyuk

+0

¡Trabaja para mí, sálvame horas! – Mike

1

Creo que estoy entendiendo su pregunta. Esto filtra elementos que están en las etiquetas de columna o en las etiquetas de fila. Las dos últimas secciones del código son las que usted quiere, pero estoy pegando todo para que pueda ver exactamente cómo se ejecuta, para empezar, con todo lo que está definido, etc. Definitivamente tomé parte de este código de otros sitios fyi.

Cerca del final del código, "WardClinic_Category" es una columna de mis datos y en la etiqueta de la columna de la tabla dinámica. Lo mismo para IVUDDCIndicator (es una columna en mis datos pero en la etiqueta de la fila de la tabla dinámica).

Espero que esto ayude a los demás ... Me ha resultado muy difícil encontrar un código que hiciera esto de la "manera correcta" en lugar de utilizar un código similar al grabador de macros.

Sub CreatingPivotTableNewData() 


'Creating pivot table 
Dim PvtTbl As PivotTable 
Dim wsData As Worksheet 
Dim rngData As Range 
Dim PvtTblCache As PivotCache 
Dim wsPvtTbl As Worksheet 
Dim pvtFld As PivotField 

'determine the worksheet which contains the source data 
Set wsData = Worksheets("Raw_Data") 

'determine the worksheet where the new PivotTable will be created 
Set wsPvtTbl = Worksheets("3N3E") 

'delete all existing Pivot Tables in the worksheet 
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property. 
For Each PvtTbl In wsPvtTbl.PivotTables 
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then 
PvtTbl.TableRange2.Clear 
End If 
Next PvtTbl 


'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache. 

'set source data range: 
Worksheets("Raw_Data").Activate 
Set rngData = wsData.Range(Range("A1"), Range("H1").End(xlDown)) 


'Creates Pivot Cache and PivotTable: 
Worksheets("Raw_Data").Activate 
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData.Address, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12 
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1") 

'Default value of ManualUpdate property is False so a PivotTable report is recalculated automatically on each change. 
'Turn this off (turn to true) to speed up code. 
PvtTbl.ManualUpdate = True 


'Adds row and columns for pivot table 
PvtTbl.AddFields RowFields:="VerifyHr", ColumnFields:=Array("WardClinic_Category", "IVUDDCIndicator") 

'Add item to the Report Filter 
PvtTbl.PivotFields("DayOfWeek").Orientation = xlPageField 


'set data field - specifically change orientation to a data field and set its function property: 
With PvtTbl.PivotFields("TotalVerified") 
.Orientation = xlDataField 
.Function = xlAverage 
.NumberFormat = "0.0" 
.Position = 1 
End With 

'Removes details in the pivot table for each item 
Worksheets("3N3E").PivotTables("PivotTable1").PivotFields("WardClinic_Category").ShowDetail = False 

'Removes pivot items from pivot table except those cases defined below (by looping through) 
For Each PivotItem In PvtTbl.PivotFields("WardClinic_Category").PivotItems 
    Select Case PivotItem.Name 
     Case "3N3E" 
      PivotItem.Visible = True 
     Case Else 
      PivotItem.Visible = False 
     End Select 
    Next PivotItem 


'Removes pivot items from pivot table except those cases defined below (by looping through) 
For Each PivotItem In PvtTbl.PivotFields("IVUDDCIndicator").PivotItems 
    Select Case PivotItem.Name 
     Case "UD", "IV" 
      PivotItem.Visible = True 
     Case Else 
      PivotItem.Visible = False 
     End Select 
    Next PivotItem 

'turn on automatic update/calculation in the Pivot Table 
PvtTbl.ManualUpdate = False 


End Sub 
1

Las últimas versiones de Excel tienen una nueva herramienta llamada Slicers. Usar slicers en VBA es en realidad más confiable que .CurrentPage (ha habido informes de errores al pasar por numerosas opciones de filtro). Aquí está un ejemplo sencillo de cómo se puede seleccionar un elemento de la máquina de cortar (recuerde que debe anular la selección de todos los valores de la máquina de cortar no relevantes):

Sub Step_Thru_SlicerItems2() 
Dim slItem As SlicerItem 
Dim i As Long 
Dim searchName as string 

Application.ScreenUpdating = False 
searchName="Value1" 

    For Each slItem In .VisibleSlicerItems 
     If slItem.Name <> .SlicerItems(1).Name Then _ 
      slItem.Selected = False 
     Else 
      slItem.Selected = True 
     End if 
    Next slItem 
End Sub 

También hay servicios como SmartKato que le ayudaría a cabo con la creación de sus cuadros de mando o informa y/o arregla tu código.

1

En Excel 2007 en adelante, puede utilizar el código mucho más simple de la siguiente manera:

dim pvt as PivotTable 
dim pvtField as PivotField 

set pvt = ActiveSheet.PivotTables("PivotTable2") 
set pvtField = pvt.PivotFiles("SavedFamilyCode") 

pvtField.PivotFilters.Add xlCaptionEquals, Value1:= "K123223" 
2

Se puede comprobar esto si lo desea. :)

Utilice este código si SavedFamilyCode está en el filtro de informe:

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 

    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters 

    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = _ 
     "K123223" 

    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
    End Sub 

Pero si el SavedFamilyCode se encuentra en la columna o fila de etiquetas utilizar este código:

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 

     ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters 

     ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").PivotFilters. _ 
    Add Type:=xlCaptionEquals, Value1:="K123223" 

    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
    End Sub 

Espero que esto te ayude.

Cuestiones relacionadas