使一个表中的所有数据透视表在模拟行中展开和折叠

好吧，我是VBA新手，但我知道这一定是可能的。 我花了一段时间编写Android应用程序，但我不会称自己几乎是一个专家，可能不是中间的说实话。 不过，唉，excel不使用java。 这是我的问题：

我所需要做的就是在同一张纸上创build6个其他数据透视表，模仿我称之为主数据透视表的内容。 它需要模仿的唯一特征是（现在我想是），当小学扩展/崩溃，其他人应该效仿。

我猜测，代码将类似于java中的onclicklistener，当代码在主数据透视表中“听到”一个折叠或扩展的点击时，它只会将相同的折叠或扩展应用到其他六个。 其他6个枢轴将始终具有相同的行标签，因此将点击从“主位置”传递给其他位置的错误不会成为问题。

我试图在我的数据透视表中logging其中一个行标签的扩展，并得到这个代码。

ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").PivotItems("2005"). _ ShowDetail = True 

我知道，这是执行扩展的代码（和ShowDetail = False会使它崩溃）。 我想我所需要的就像我说的，一个倾听者可以“听到”主数据透视表的任何展开/折叠的点击，这是一种存储/传输点击行标签的信息的方法（“位置”的点击，如果你会），然后一个通用版本的上述代码来执行另一个6使用我猜测循环的种类。

我在正确的轨道上斜线任何帮助家伙？ 非常感谢，一如既往。

Answer 1

这应该为你工作：

把它放在一个标准模块中（这是效率较低的方法 – 因为它检查所有字段）：

 Sub LinkPivotTables_ByFieldItemName_ToShowDetail(pt As PivotTable) Dim wkb As Workbook Set wkb = ThisWorkbook Dim wks As Worksheet Set wks = wkb.Sheets(1) Dim PivotTableIndex As Integer Dim PivotFieldIndex As Integer Dim PivotItemIndex As Integer Dim PivotFieldIndexName As String Dim PivotItemIndexName As String Dim BoolValue As Boolean Application.ScreenUpdating = False Application.EnableEvents = False On Error Resume Next For PivotFieldIndex = 1 To pt.PivotFields.Count PivotFieldIndexName = pt.PivotFields(PivotFieldIndex).Name For PivotItemsIndex = 1 To pt.PivotFields(PivotFieldIndex).PivotItems.Count PivotItemIndexName = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).Name BoolValue = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail For PivotTableIndex = 1 To wks.PivotTables.Count ' This If statement will dramatically increase efficiency - because it takes a long long time to set the value but it doesn't take long to check it. If wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndexName).PivotItems(PivotItemIndexName).ShowDetail <> BoolValue Then wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndexName).PivotItems(PivotItemIndexName).ShowDetail = BoolValue End If Next PivotTableIndex Next PivotItemsIndex Next PivotFieldIndex Application.ScreenUpdating = True Application.EnableEvents = True End Sub 

然后在任何数据透视表编辑中自动运行这个macros，你需要把它放在你的Sheet1代码中（让我知道如果你需要帮助的话）。

 Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) Call LinkPivotTables_ByFieldItemName_ToShowDetail(Target) End Sub 

如果所有的数据透视表都在第一张表上，它将会起作用。 您可能必须首先复制/粘贴到写字板或其他文本编辑器，因为我不担心行长限制（小心换行）。

编辑/添加：

这是你如何把代码放在一个特定的图表对象上：

编辑2 /附加2 – 效率方法：

这种方法将大大提高效率，但你必须具体告诉它哪个字段你想同步（它不会全部同步）：

 Sub LinkPivotTables_ByFieldItemName_ToShowDetail(pt As PivotTable) 'takes as argument - pt As PivotTable Dim wkb As Workbook Set wkb = ThisWorkbook Dim wks As Worksheet Set wks = wkb.Sheets(1) Dim PivotTableIndex As Integer Dim PivotItemIndex As Integer Dim PivotFieldIndex As String Dim BoolValue As Boolean Dim ItemName As String Application.ScreenUpdating = False Application.EnableEvents = False PivotFieldIndex = "Year" On Error Resume Next For PivotItemsIndex = 1 To pt.PivotFields(PivotFieldIndex).PivotItems.Count BoolValue = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail ItemName = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).Name For PivotTableIndex = 1 To wks.PivotTables.Count ' This If statement will dramatically increase efficiency - because it takes a long long time to set the value but it doesn't take long to check it. If wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail <> BoolValue Then wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail = BoolValue End If Next PivotTableIndex Next PivotItemsIndex Application.ScreenUpdating = True Application.EnableEvents = True End Sub 

你将不得不在这一行中手动告诉它你想要同步的字段：

 PivotFieldIndex = "Year" 

我发现了其他几个在线的解决scheme，它们使用相同的循环方法来同步数据透视表 – 问题是，当您获得体面的数据透视表时，它们都会遇到相同的效率问题。 通过包含一个IF语句，在设置Item.ShowDetail的值之前（因为设置值的时间比检查它的时间更长），这些有点绕过这个问题。 祝你好运。