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

这比你要求的要多一点，但我想我会分享，因为我刚写了这个供我自己使用。只有在过滤（而不是全部选定）时，它才会清除物理上位于工作表上的所有切片器。对于你的问题，好的一点是每个项目循环。和它之后的那条线。

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 2

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

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

2 个答案: