使用VBA更新Excel切片器选择时性能不佳

我使用VBA模拟单击Excel切片器，但遇到了严重的性能问题

用户单击X轴上带有日期的柱状图。单击列时，将在包含日期列表的切片器中选择相应的日期。随着时间的推移，名单将继续增加

据我所知，为非OLAP数据源（我的案例）设置切片器选择的唯一方法是为每个切片器项分别设置selected=true。由于每个设置都会触发重新计算，因此对于包含许多项的切片器来说，这非常缓慢

显示问题的小代码示例：

On Error GoTo Err_Handler:

Dim SC As SlicerCache
Set SC = ActiveWorkbook.SlicerCaches("Slicer_DATE")

Dim SI As SlicerItem

Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each SI In SC.SlicerItems
    SI.Selected = True
Next

Err_Handler:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

以前也曾提出过类似的问题：

建议如下：

Application.EnableEvents = false

或

更新：我还注意到，尽管关闭了事件和计算，所有透视表实际上都在重新计算

对我来说，这两个选项都不起作用，也不能提高性能。计算确实被推迟，并且没有触发任何事件。不过，selected=true的每次迭代大约需要1.5秒。操作总共需要大约5分钟才能完成

我的切片器连接到多张图纸中的23个透视表（！）。底层数据（MS Access DB connection）约为60000行，包含约20个变量，这并不多

---

感谢您的帮助

数据透视表具有可设置为

True

的

ManualUpdate

属性。为所有数据透视设置此属性可能有助于加快代码的速度

请尝试在更新切片器代码的正上方添加此代码：

Dim PT As PivotTable
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

For Each ws In wb.Sheets
    For Each PT In ws.PivotTables
        PT.ManualUpdate = True
    Next PT
Next ws

然后在更新切片器后添加以下内容：

For Each ws In wb.Sheets
    For Each PT In ws.PivotTables
        PT.ManualUpdate = False
    Next PT
Next ws

有关更多信息：

---

希望有帮助

您需要做的是复制切片器和 将字段复制为切片器和报告筛选器 看

然后使用CurrentPage属性选择项目：

Private Sub SelectPivotItem(FieldName As String, Itemname As String)
    Dim PT As PivotTable, PTF As PivotField, PTI As PivotItem
    Set PT = shtInt.PivotTables("PivotTable1")
    Set PTF = PT.PivotFields(FieldName)
    PTF.ClearAllFilters
    PTF.CurrentPage = Itemname
End Sub

---

这对性能有很大帮助。同样的方法也适用于在VBA中选择多个数据透视项

将数据透视表设置为手动更新

在执行多个切片器选择时，隐藏包含受切片器影响的透视表的所有工作表

完成后，不要忘记将透视表设置为“不手动更新”，如果需要，请在之后将图纸设置为可见

这很奇怪，因为即使使用Application.screenUpdatement=False，这仍然非常有帮助

通过这样做，我的数据透视项选择宏从3分钟下降到了3秒。完全不同

---

不幸的是，切片机的速度仍然很慢，大约30秒。我希望切换回使用VBA和PivotItems，并完全避免使用切片器，除非我能找到其他方法来提高性能。

非常感谢。我设法解决了这个问题。唯一的问题是，当设置ManualUpdate=False时，所有自定义系列格式都会丢失，我必须记录一个宏，以便在代码末尾运行，以正确设置格式。很高兴它有帮助！谢谢你的跟进！我尝试了以上所有的方法，但在我的一个有50多个选项的切片器中仍然有明显的延迟（我有4个级联切片器）。设置所选值很慢，在我的例子中，将除一个以外的所有值都设置为false。我通过忽略那些具有“.hasdata=false”的值来加快速度，因为将它们设置为false对下一个依赖切片器选择的值没有影响。

Private Sub SelectPivotItem(FieldName As String, Itemname As String)
    Dim PT As PivotTable, PTF As PivotField, PTI As PivotItem
    Set PT = shtInt.PivotTables("PivotTable1")
    Set PTF = PT.PivotFields(FieldName)
    PTF.ClearAllFilters
    PTF.CurrentPage = Itemname
End Sub