使用 VBA 选择和取消选择多个切片器项目（OLAP 数据）答案

【问题标题】：Use VBA to select and deselect multiple slicer items (OLAP data)使用 VBA 选择和取消选择多个切片器项目（OLAP 数据）
【发布时间】：2018-03-29 13:07:01
【问题描述】：

我正在编写一个仅选择所需切片器项目的脚本。我尝试使用.SlicerItems.Selected = True / False 进行选择和取消选择，但我使用的是OLAP 数据源，在这种情况下.Selected 是只读的。切片器项目的格式为 YYYYWW，因此 2018 年的第 7 周将是 201807。

我录制了一个选择一些切片器项目的宏，这就是它给我的：

Sub Macro2()
    ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
        "[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
        "[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
        "[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
        "[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
        "[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
        "[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
        "[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
        "[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
        "[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
        "[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
        "[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
        "[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
        "[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
        "[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
        "[Results].[YYYYWW].&[201803]")
End Sub

所以我尝试按照这个模板创建一个这样的数组。这是我已经走了多远：

Sub arrayTest()

Dim startDate As Long
    Dim endDate As Long
    Dim n As Long
    Dim i As Long
    Dim strN As String
    Dim sl As SlicerItem
    Dim strArr As Variant
    Dim dur As Long
    Dim result As String

    endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
    startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
    dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
    i = 0
    ReDim strArr(dur) As Variant
    With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
'            .ClearManualFilter
        For n = startDate To endDate
            strN = CStr(n) ' convert n to string
            If n = 201753 Then ' this is needed for when the year changes
                strN = CStr(201801)
                n = 201801
            End If
            strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
            i = i + 1

'                For Each sl In .SlicerCacheLevels(1).SlicerItems
'                    If sl.Name = strN Then
'                        sl.Selected = True
'                    Else
'                        sl.Selected = False ' this is read-only for OLAP data so it's not working
'                    End If
'                Next

        Next
        MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items

        .VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
    End With

End Sub

目前，代码给出了错误 13：.VisibleSlicerItemsList = Join(strArr, ", ") 上的类型不匹配，这也被注释掉了。所以我猜想将 strArr 标注为 Variant 是错误的，数据没有正确插入 strArr 或者不可能这样做。如果是最新的，应该怎么做呢？

第 29-35 行注释掉的部分不起作用，因为它在sl.Selected = False 上给出了应用程序定义或对象定义错误 (1004) 的常见错误。

【问题讨论】：

您尝试过滤的项目之一是否可能不存在于数据中？您能否在 Watch 窗口中发布显示数组的屏幕截图，以便我们检查您的代码是否正确格式化了存储在数组中的内容？
是的，切片器项目列表中可能不存在该项目。但是，现在我已经检查了我要选择的所有项目确实存在。将来，是的，这个问题必须解决，但现在我正试图让切片器选择工作。 Watch 窗口的图像是在接近末尾 (ln 38) 执行 MsgBox 之后拍摄的。 imageupload.co.uk/image/Ehbv
警告：围绕不存在的项目进行编码非常棘手：我制作了一个商业应用程序，允许用户在此类搜索（包括通配符）上过滤 OLAP 和非 OLAP 数据透视表，我发现我必须使用数据透视表的副本，其中感兴趣的字段未经过滤，因此我可以确认项目是否存在。因为如果他们不这样做，您会在下面我的回答中得到您在评论中提到的错误。可以说这是相当棘手的，涉及大量代码，如果我以前的经验有效，无疑需要相当长的时间才能纠正。
您基本上只是想为人们提供一种比使用切片器更简单的方法来选择事物吗？也许您不希望他们必须在切片器上单击拖动来选择大量项目？

标签： vba olap slicers

【解决方案1】：

我有一个类似的问题需要克服。我使用以下代码解决了这个问题：

Sub show_SlicerItems()

Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long

Application.ScreenUpdating = False

    Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
    Set sL = sc.SlicerCacheLevels(1)

    ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter

    i = 0

    For Each si In sL.SlicerItems
        ReDim Preserve slicerItems_Array(i)

        If si.Value <> 0 Then
            slicerItems_Array(i) = si.Name
            i = i + 1
        End If
    Next

sc.VisibleSlicerItemsList = Array(slicerItems_Array)

Application.ScreenUpdating = True
End Sub

【讨论】：

【解决方案2】：

您需要为 .VisibleSlicerItemsList 提供一个数组，而不是一个字符串。放弃加入。

你的 strArr 分配应该是这样的：strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" 即你不需要用额外的 " 来填充它

编辑：出于兴趣，我碰巧正在构建一个商业插件，它实际上是一个弹出式切片器，它允许您过滤 OLAP 数据透视表以显示范围之间的所有项目，就像您尝试做的那样。它还允许您过滤通配符、AND 和 OR 的疯狂组合，以及过滤存储在外部范围中的列表。

这是它的运行截图。请注意，顶部有一个搜索栏，可让您使用一起设置下限和上限，这是我在当前搜索中所做的。您可以看到结果：它已正确识别出 PivotField 中符合要求的 14 个项目。

过滤这些数据透视表所需要做的就是单击“过滤所选项目”选项，它就是这样做的：

但是研究如何做到这一点 - 特别是考虑到数据透视表对象模型的局限性（尤其是在 OLAP 数据透视表方面）是一个非常长期的项目，需要克服许多障碍才能使其无缝工作。恐怕我不能分享代码，因为这是我打算很快发布的商业产品。但我只是想强调，虽然这当然是可能的，但如果你希望它在项目不存在时不抛出错误，你会咬牙切齿。

【讨论】：

放弃加入后，我收到“运行时错误'1004'：应用程序定义或对象定义错误”。如果我从分配 strArr 中删除额外的引号，我会收到“运行时错误 '1004'：在 OLAP 多维数据集中找不到该项目”。这两个错误都发生在 .VisibleSlicerItemsList (ln 40)
代码在我创建的示例数据上运行良好。如果您尝试使用非常少量的日期怎么办？即只有两个？只是为了绝对确认这些东西都在您的 PivotField 中。我能想到这种情况的唯一其他原因是，如果您的 PivotField 是所谓的成员键。这些显示一件事（例如“詹姆斯邦德”），但在幕后可能被立方体称为另一件事（例如“007”）。

【解决方案3】：

忘记我的其他答案...您可以使用标签过滤器轻松完成此操作，前提是感兴趣的字段在数据透视表中作为行或列字段。启动宏记录器，然后执行以下操作：

...您会看到数据透视表已被过滤：

...生成的代码非常简单：

ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
        ).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
        "201803"

【讨论】：

@OscarEskor 如果此答案解决了您的问题，请单击复选标记考虑accepting it。这向更广泛的社区表明您已经找到了解决方案，并为回答者和您自己提供了一些声誉。没有义务这样做。
抱歉回复太长了。我使用的是数据透视图而不是数据透视表，所以我不确定如何使用 VBA 向其中添加过滤器。