Question

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

这是我的代码：

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代码的变体（来自Chris的回复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

Answer 1

如果您迭代PivotItems，在进行更改时将数据透视表的.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的高级版本。但是，只要输入表发生更改，就需要刷新数据透视表。

加速切片器在VBA中循环

1 个答案: