加速 VBA 中的切片器循环答案

【问题标题】：Speed Up Slicer Looping in VBA加速 VBA 中的切片器循环
【发布时间】：2018-04-17 19:56:43
【问题描述】：

我正在尝试根据另一个选项卡上的一些 True/False 值对数据透视表进行排序。我读过最简单的方法是使用切片器。代码成功执行，但运行排序通过 230 个 SlicerItem 需要大约 45 秒。关于如何加快速度有什么想法吗？

这是我的代码：

Sub CategoryMacro()
'Runs through Pivot Slicer and selects items from pivot table that meet certain certain TRUE/FALSE on MacroHelper

Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim kpicat As String

'Speed Up
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set wb = ThisWorkbook
Set ws1 = wb.Sheets("MacroHelper")
Set ws2 = wb.Sheets("Visual")

'Prep with some clean-up
ws2.Activate
ActiveWorkbook.SlicerCaches("Slicer_PRODNAME").ClearManualFilter

'Toggles off products with decreasing margin
For i = 2 To 230
    Let kpicat = ws1.Range("A" & i).Value
    If ws1.Range("D" & i).Value = 0 Then ActiveWorkbook.SlicerCaches("Slicer_PRODNAME").SlicerItems(kpicat).Selected = False
Next i

'Un-Speed Up
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

我在大型数据集上非常成功地使用了这个ReDim 代码的变体（来自克里斯的回复中的here），但我不确定它是否可以在这里应用。如果可以，我不确定我会如何应用它。

Sub GetRows()
    Dim valMatch As String
    Dim rData As Range
    Dim a() As Long, z As Variant
    Dim x As Long, i As Long
    Dim sCompare As String

    Set rData = Range("A1:A50000")
    z = rData
    ReDim a(1 To UBound(z, 1))
    x = 1
    sCompare = "aa"
    For i = 1 To UBound(z)
        If z(i, 1) = sCompare Then a(x) = i: x = x + 1
    Next
    ReDim Preserve a(1 To x - 1)    
End Sub

【问题讨论】：

由于您的代码可以正常运行但运行缓慢，它可能更适合Code Review
您可以做很多事情来从根本上加快速度，我会尽快回复。但首先，您运行的是哪个版本的 Excel？
@jeffreyweir 我正在运行 excel 2016。
@MattCottrill 酷。在下面查看我修改后的答案和相关链接，您会找到快速完成此任务所需的内容。

标签： vba excel for-loop pivot slicers

【解决方案1】：

如果您曾经迭代过数据透视表，请在进行更改时将数据透视表的 .ManualUpdate 设置为 TRUE，然后再将其设置回 FALSE 以避免每次更改后数据透视表都刷新。这将从根本上加快您的代码速度。

在How to update slicer cache with VBA 上查看我的答案，了解快速过滤数组上的切片器的代码。

请注意，将某种“真/假”字段添加到数据透视表中会更快，方法是向数据添加查阅列，然后将该字段作为 PageField 放入数据透视表，并将 PageField 值设置为“真的”。这将几乎立即过滤您的数据透视表而无需迭代。

有关高效编程数据透视表的更多信息，请查看我的博客文章http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/

如果您拥有 Excel 2016，您还可以使用Measures 和DataModel 通过链接表执行此操作，无论您是否拥有安装了PowerPivot 的高级版本。但它需要您在输入表更改时刷新数据透视表。

【讨论】：