保存和加载 Excel 切片器缓存

Question

我遇到了一个简单的 VBA 来检查切片器缓存 Excel 工作簿中的所有活动切片器。

Sub RetrieveSlicers()
Dim caches As Excel.SlicerCaches
Set caches = ActiveWorkbook.SlicerCaches
End Sub

通过在End Sub 旁边放置一个断点，右键单击cache 并选择“添加观察...”

（见下文）

您可以通过“Watches”窗口查看每个活动切片器中的所有项目。

我的问题是，我可以保存切片器缓存信息（特别是 SlicerItems）以备后用（可能作为文本数组？），然后将保存的切片器缓存加载回切片器（使用保存的 SlicerItems 重新填充切片器）？

下面的例子：

我确信获取 Slicer Cache 数据很容易，设置 Slicer Cache 数据也一样容易。

非常感谢任何帮助。

先生。 J

Answer 1

这样的东西应该可以工作（我目前没有要测试的东西）：

Sub Save_Slicers()
Dim SliCaches As Excel.SlicerCaches
Dim SliCache As Excel.SlicerCache
Dim SliCName As String
Dim sliIt As Excel.SlicerItem
Dim A()
ReDim A(1 To 3, 1 To 1)

A(1, 1) = "Slicer Cache Name"
A(2, 1) = "Slicer Item Name"
A(3, 1) = "Selected"
ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) + 1)

Set SliCaches = ActiveWorkbook.SlicerCaches
For Each SliCache In SliCaches
    SliCName = SliCache.Name
    For Each sliIt In SliCache.SlicerItems
        A(1, UBound(A, 2)) = SliCName
        A(2, UBound(A, 2)) = sliIt.Name
        A(3, UBound(A, 2)) = sliIt.Selected
        ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) + 1)
    Next sliIt
Next SliCache
ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) - 1)

'Print it in a sheet
Sheets("Sheet1").Range("A1").Resize(UBound(A, 2), UBound(A, 1)).Value = Application.Transpose(A)
End Sub

与手动切片器缓存选择器相同：

Sub Save_Selected_Slicers()
Dim SliCaches As Excel.SlicerCaches
Dim SliCache As Excel.SlicerCache
Dim SliCName As String
Dim sliIt As Excel.SlicerItem
Dim SaveSlice As Single
Dim A()
ReDim A(1 To 3, 1 To 1)

A(1, 1) = "Slicer Cache Name"
A(2, 1) = "Slicer Item Name"
A(3, 1) = "Selected"
ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) + 1)

Set SliCaches = ActiveWorkbook.SlicerCaches
For Each SliCache In SliCaches
    SliCName = SliCache.Name
    SaveSlice = MsgBox("Do you want to save " & SliCName & " ?", vbYesNo, "Save slicers")
    If SaveSlice <> vbYes Then
    Else
        For Each sliIt In SliCache.SlicerItems
            A(1, UBound(A, 2)) = SliCName
            A(2, UBound(A, 2)) = sliIt.Name
            A(3, UBound(A, 2)) = sliIt.Selected
            ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) + 1)
        Next sliIt
    End If
Next SliCache
ReDim Preserve A(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2) - 1)
'Print it in a sheet
Sheets("Sheet1").Range("A1").Resize(UBound(A, 2), UBound(A, 1)).Value = Application.Transpose(A)
End Sub

然后加载：

Sub Load_Slicers()
Dim SliCaches As Excel.SlicerCaches
Dim SliCache As Excel.SlicerCache
Dim sliIt As Excel.SlicerItem
Dim i As Double
Dim A()
'Load the array you printed
A = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp)).Value


Set SliCaches = ActiveWorkbook.SlicerCaches
For i = LBound(A, 1) To UBound(A, 1)
    For Each SliCache In SliCaches
        If SliCache.Name <> A(i, 1) Then
        Else
            For Each sliIt In SliCache.SlicerItems
                If sliIt.Name <> A(i, 2) Then
                Else
                    sliIt.Selected = A(i, 3)
                End If
            Next sliIt
        End If
    Next SliCache
Next i
End Sub

Answer 2

遍历 SlicerItems 或 PivotItems 真的很慢 - 我写了一篇文章来检查瓶颈，我建议你看看： http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/

这是另一种方法，在大枢轴上速度会快得多。我们将您的原始数据透视表称为 ptOriginal。

1. 复制 ptOriginal 并将其放置在隐藏的工作表中。我们称之为 ptTemp
2. 从中删除除感兴趣的字段之外的所有字段。我们称之为 pfTemp。
3. 断开它与切片器的连接。
4. 在该字段上添加一个新的切片器。我们称之为 slrTemp

如果您想在以后恢复设置，请将 slrTemp 连接到 ptOriginal。

这是可行的，因为 Excel 在幕后合理化了 SlicerCache，并保留了您刚刚更改连接时的设置。有关更多信息，请参阅我在 http://dailydoseofexcel.com/archives/2014/08/05/slicers-and-slicercaches/ 的文章。