Excel VBA - 检查报告切片器选择（如果选择全部，则跳过）

Question

我需要一些 VBA 代码方面的帮助。我有一个 AgeRange 切片器，我有一个可以插入行、添加时间戳、然后报告切片器选择的工作脚本。

我想在此添加一些内容，如果切片器中的所有项目都被选中 (True)，将跳过该过程。

有没有我可以插入的东西，上面写着“如果切片器没有被触摸（所有项目都是真的），那么结束子”。

这是我目前所拥有的代码：

Dim cache As Excel.SlicerCache
Set cache = ActiveWorkbook.SlicerCaches("Slicer_AgeRange")
Dim sItem As Excel.SlicerItem
For Each sItem In cache.SlicerItems
If sItem.Selected = True Then xAge = xAge & sItem.Name & ", "
Next sItem
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")
Range("B1").Select
ActiveCell.FormulaR1C1 = xAge
Range("C1").Select
End Sub

非常感谢任何帮助！

Answer 1

NVM。我自己搞定的。 :)

Dim cache As Excel.SlicerCache
Dim sName As Slicers
Dim sItem As Excel.SlicerItem
Dim xSlice As String
Dim xName As String

For Each cache In ActiveWorkbook.SlicerCaches

    xName = StrConv(Replace(cache.Name,     "AgeRange", "Ages")
    xCheck = 0
    For Each sItem In cache.SlicerItems
        If sItem.Selected = False Then
            xCheck = xCheck + 1
        Else
            xCheck = xCheck
        End If
    Next sItem

    If xCheck > 0 Then
    For Each sItem In cache.SlicerItems
        If sItem.Selected = True Then
            xSlice = xSlice & sItem.Caption & ", "
        End If
    Next sItem

        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B1").Select
        ActiveCell.FormulaR1C1 = xName & ": " & xSlice
        xSlice = ""
    End If

Next cache

    Range("A1").Select
    ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")


End Sub

Answer 2

这比你要求的要多，但我想我会分享，因为我只是写这个供我自己使用。仅当它们被过滤（不是全部选中）时，它才会清除物理上位于工作表上的所有切片器。对于您的问题，好的一点是 for each item 循环。以及紧随其后的那一行。

Sub clearWorksheetSlicers(ws As Worksheet)
'clears all slicers that have their shape on a specific worksheet

Dim slSlicer As Slicer
Dim slCache As SlicerCache
Dim item As SlicerItem
Dim hasUnSel As Boolean

For Each slCache In ThisWorkbook.SlicerCaches
    For Each slSlicer In slCache.Slicers
        If slSlicer.Shape.Parent Is ws Then
            For Each item In slCache.SlicerItems
                If item.Selected = False Then
                    hasUnSel = True
                    Exit For
                End If
            Next item
            If hasUnSel = True Then slCache.ClearManualFilter
            hasUnSel = False
        End If
    Next slSlicer
Next slCache

End Sub

Answer 3

达拉斯弗兰克的这个线程中的代码看起来应该可以工作，并且所有明确调用的属性确实存在，但由于某种原因，在我的数据透视表中，SlicerItems 集合为空。我必须通过

检查每个 SlicerItem

SlicerCache.SlicerCacheLevels.Item(1).SlicerItems

这个替换并不完全是原始请求者所要求的，但它说明了 SlicerCacheLevel 的使用，当 SlicerCache.SlicerItems 原来不存在时，它让我到达了我需要的位置

Sub AllSlicersSelected(WorksheetWithPT As Worksheet)
Dim SlicerItems                 As SlicerItems
Dim SlicerItem                  As SlicerItem
Dim SlicerCaches                As SlicerCaches
Dim SlicerCache                 As SlicerCache
Dim SlicerCacheLevel            As SlicerCacheLevel
Dim Slicer                      As Slicer
Dim strSlicerItemsNotSelected   As String
Dim bHaveWhatWeNeed             As Boolean
Dim vSlicerItemsToSelect        As Variant

Set SlicerCaches = ThisWorkbook.SlicerCaches
For Each SlicerCache In SlicerCaches
    For Each Slicer In SlicerCache.Slicers
        If Slicer.Shape.Parent Is WorksheetWithPT Then
            bHaveWhatWeNeed = True
            Exit For
        End If
    Next
    If bHaveWhatWeNeed Then
        Exit For
    End If
Next

For Each SlicerCacheLevel In SlicerCache.SlicerCacheLevels
    For Each SlicerItem In SlicerCacheLevel.SlicerItems
        If Not SlicerItem.Selected Then
            strSlicerItemsNotSelected = strSlicerItemsNotSelected & Chr(0)
        End If
    Next
Next

If Len(strSlicerItemsNotSelected) > 0 Then
    vSlicerItemsToSelect = Split(Mid(strSlicerItemsNotSelected, 2), Chr(0))
    For Each SlicerItem In vSlicerItemsToSelect
        SlicerItem.Selected = True
    Next
End If

End Sub