vba - 保存和加载 Excel 切片器缓存

Question

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

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

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

（见下文）

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

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

下面的例子：

我确信获取 Slicer Cache 数据就像获取Slicer Cache 数据一样简单，设置Slicer Cache 数据也同样简单。

一如既往的任何帮助都非常感谢。

J先生

score 1 · Accepted Answer

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

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

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

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

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

score 1 · Accepted Answer

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

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

vba - 保存和加载 Excel 切片器缓存

2 回答 2

Related

Reference