Сохраните и загрузите кеш слайдера Excel

Question

Я столкнулся с простой частью VBA, чтобы проверить кэш-память слайсера всех активных Slicers в книге Excel.

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

Размещая брейк-пойнт рядом с End Sub, щелкнув правой кнопкой мыши на cache и выбрав пункт "Add Watch ...

(см ниже)

Вы может просматривать все элементы в каждом активном слайсере через окно «Часы».

Мой вопрос, могу ли я сохранить данные кэша Тесак (в частности SlicerItems) для последующего использования (возможно, в виде текстового массива?), А затем загрузить это спасло кэш SLICER обратно в ломтерезки (повторное заполнение ломтерезки с сохраненными SlicerItems)?

Пример ниже:

Я уверен, что это так просто, как get Данные кэширования Slicer, это будет так же просто, как set Данные кэширования Slicer.

Любая помощь, как всегда, очень ценится.

г-н Дж

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/

Вот еще один подход, который будет щеколдой из многих быстрее на больших поворотах. Давайте назовем ваш исходный PivotTable ptOriginal.

1. Сделайте копию ptOriginal и поместите его на скрытый лист. Назовем это ptTemp
2. Удалите из него все поля, кроме интересующего. Назовем это pfTemp.
3. Отсоедините его от Slicer.
4. Добавить новый Slicer в это поле. Назовем его slrTemp

Если вы хотите восстановить настройки позднее, подключите slrTemp к ptOriginal.

Это работает, потому что Excel рационализирует SlicerCaches за кулисами и сохраняет настройки от того, на котором вы только что изменили подключения. См. Мою статью в http://dailydoseofexcel.com/archives/2014/08/05/slicers-and-slicercaches/ для получения дополнительной информации об этом.