通过VBA迭代切片器并每次选择一个项目

jod*_*oox 1 excel vba excel-vba

我在spreadhseet中有几个切片器.我希望能够通过VBA循环遍历其中一个,并逐个选择每个选项.下面的宏似乎对我疲惫的眼睛很好,但是当我运行它时它显然不起作用.当我在下面的'BREAKPOINT标签处添加断点时,第一个项目被选中,但随后宏转到第二个,同时保持第一个选中,我最终选择了所有项目...

    Sub slicers(slName As String)
    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache
    Set slBox = ActiveWorkbook.SlicerCaches(slName)
    For Each slItem In slBox .SlicerItems
      For Each slDummy In slBox .SlicerItems
          slDummy.Selected = (slDummy.Name = slItem.Name)
      Next slDummy
    Next slItem 'BREAKPOINT
    End Sub

    Sub test()
    Call slicers("A_slicer_name")
    End Sub
Run Code Online (Sandbox Code Playgroud)

谢谢你的帮助

编辑:
正如Scott Holtzman所指出的那样,我只需要在选择新项目时清除过滤器(slBox.ClearManualFilter).

为什么这是必要的,而布尔测试在我调试它时是否正常工作呢?

下面的代码工作正常:

    Sub slicers(slName As String)
    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache
    Set slBox = ActiveWorkbook.SlicerCaches(slName)
    For Each slItem In slBox .SlicerItems
      slBox.ClearManualFilter 'THIS IS THE LINE I NEEDED TO ADD
      For Each slDummy In slBox .SlicerItems
          slDummy.Selected = (slDummy.Name = slItem.Name)
      Next slDummy
    Next slItem
    End Sub

    Sub test()
    Call slicers("A_slicer_name")
    End Sub
Run Code Online (Sandbox Code Playgroud)

Sco*_*man 7

由于我在评论中将您链接到的问题没有接受答案(用户从不选择回答或回复我的建议),我也会在此提供您的问题的解决方案.

Sub slicers(slName As String)

    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache

    Set slBox = ActiveWorkbook.SlicerCaches(slName)

    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ShowAllItems 'or .ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

            'more code to process the data (I suspect)

        Next slDummy

    Next slItem

End Sub
Run Code Online (Sandbox Code Playgroud)

  • 谢谢。`slBox.ClearManualFilter`是我需要添加的内容。 (2认同)