0

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

如果切片器中的所有项目都被选中（真），我想添加一些内容将跳过该过程。

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

到目前为止，这是我的代码：

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

任何帮助是极大的赞赏！

4

3 回答 3

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
于 2014-12-09T20:09:05.480 回答
0

非易失性。我自己弄的。:)

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
于 2013-04-12T22:07:30.673 回答
0

Dallas Frank 的这个线程中的代码看起来应该可以工作，并且所有显式调用的属性都存在，但由于某种原因，在我的数据透视表中，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
于 2021-11-21T10:46:13.177 回答