Question

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

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

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

（见下文）

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

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

以下示例：

我确信获取切片缓存数据非常简单，设置切片缓存数据也很容易。

我们非常感谢任何帮助。

先生。 Ĵ

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/

这是另一种方法，在大支柱上将会更快的 heck 。我们打电话给你原来的PivotTable ptOriginal。

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

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

这很有效，因为Excel会在幕后合理化SlicerCaches，并保持您刚刚更改连接的设置。有关详情，请参阅http://dailydoseofexcel.com/archives/2014/08/05/slicers-and-slicercaches/上的文章。

保存并加载Excel切片缓存

2 个答案: