如何用数组值修改OLAP数据透视表的切片器项？

问题描述 #

我有一个包含OLAP多维数据集数据透视表的工作簿，需要用选中单元格区域的值修改透视表的切片器。单个值的解决方案可行，但用数组时出现类型不匹配错误。目标字段为[Branch Name]，使用的代码如下：

Dim sel_Array As Variant
Dim rng As Range

'Set rng = Selection

sel_Array = Selection.Value

ActiveWorkbook.SlicerCaches("Slicer_Branch_Name").VisibleSlicerItemsList = Array("[Dim Location].[Branch Name].&[" & sel_Array & "]")

我也尝试用rng.Value赋值给VisibleSlicerItemsList，同样无效。

问题原因 #

单元格区域的Value返回的是二维变体数组（哪怕是单行或单列区域），直接和字符串拼接无法生成符合要求的切片器项格式，进而导致类型不匹配错误。而OLAP切片器的VisibleSlicerItemsList需要接收一维字符串数组，每个元素必须严格遵循[维度].[字段].&[值]的格式。

解决方案 #

遍历选中区域的每个单元格，逐个生成符合格式要求的字符串，再组成一维数组赋值给目标属性：

Dim rng As Range
Dim cell As Range
Dim slicerItems() As String
Dim i As Integer

Set rng = Selection
ReDim slicerItems(1 To rng.Cells.Count)

i = 1
For Each cell In rng
    slicerItems(i) = "[Dim Location].[Branch Name].&[" & cell.Value & "]"
    i = i + 1
Next cell

ActiveWorkbook.SlicerCaches("Slicer_Branch_Name").VisibleSlicerItemsList = slicerItems

补充优化 #

如果选中区域包含空单元格，可添加判断跳过无效值，避免生成错误的切片器项：

Dim rng As Range
Dim cell As Range
Dim slicerItems() As String
Dim i As Integer

Set rng = Selection
i = 1

For Each cell In rng
    If cell.Value <> "" Then
        ReDim Preserve slicerItems(1 To i)
        slicerItems(i) = "[Dim Location].[Branch Name].&[" & cell.Value & "]"
        i = i + 1
    End If
Next cell

' 确保数组不为空时再赋值
If i > 1 Then
    ActiveWorkbook.SlicerCaches("Slicer_Branch_Name").VisibleSlicerItemsList = slicerItems
End If

内容的提问来源于stack exchange，提问作者Sean