0

我正在尝试根据另一个选项卡上的一些 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来自Chris 的回复），但我不确定它是否可以在这里应用。如果可以，我不确定我会如何应用它。

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
4

1 回答 1

0

如果您曾经遍历 PivotItems，请在进行更改时将 PivotTable 的 .ManualUpdate 设置为 TRUE，然后再将其设置回 FALSE 以避免在每次更改后刷新 PivotTable。这将从根本上加快您的代码速度。

请参阅我在如何使用 VBA 更新切片器缓存中的答案，以获取快速过滤数组上切片器的代码。

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

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

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

于 2018-04-17T21:44:35.730 回答