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 の応答からの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
4

1 に答える 1