將切片器選擇新增至清單中的工作表 - Excel VBA

Question

我有一個帶有切片器的資料透視表，使用者可以在其中進行多項選擇。我正在使用下面的程式碼。

目前，儲存格 L5:L7 填入了切片器中所做的第一個選擇，但沒有其他選擇。

我做了一些研究，發現了 CUBESET 函數的可能解決方案，但我無法讓它在我的電子表格中工作。因此進行了 VBA 嘗試。有人知道這是怎麼回事嗎？

    Sub City_Click()

Dim cache As Excel.SlicerCache
Set cache = ActiveWorkbook.SlicerCaches("Slicer_City")
Dim sItem As Excel.SlicerItem
For Each sItem In cache.SlicerItems

If sItem.Selected = True Then Range("L5").Value = sItem.Name
If sItem.Selected = True Then Range("L6").Value = sItem.Name
If sItem.Selected = True Then Range("L7").Value = sItem.Name

Next sItem

End Sub

Answer 1

這是一個使用者定義函數，您可以直接從為您執行此操作的工作簿中呼叫該函數，並且可以在任何類型的切片器上運行，無論是「傳統」資料透視表、OLAP/PowerPivot 資料透視表還是表切片器。只需將其放入標準程式碼模組中，然後在工作簿中鍵入以下內容：

=SlicerItems("Slicer_City")

Public Function SlicerItems(SlicerName As String, Optional sDelimiter As String = "|") As String

    Dim oSc As SlicerCache
    Dim oSi As SlicerItem
    Dim i As Long
    Dim lVisible As Long
    Dim sVisible() As String

    On Error Resume Next
    Application.Volatile
    Set oSc = ThisWorkbook.SlicerCaches(SlicerName)
    If Not oSc Is Nothing Then
        With oSc
            If .FilterCleared Then
                SlicerItems = "(All)"
            Else
                If .OLAP Then
                    SlicerItems = Join(.VisibleSlicerItemsList, sDelimiter)
                    SlicerItems = Replace(SlicerItems, .SourceName, "")
                    SlicerItems = Replace(SlicerItems, ".&[", "")
                    SlicerItems = Replace(SlicerItems, "]", "")
                Else

                    lVisible = .VisibleSlicerItems.Count
                    If .VisibleSlicerItems.Count = 1 Then
                        SlicerItems = .VisibleSlicerItems(1).Name
                    Else
                        ReDim sVisible(1 To lVisible)
                        For i = 1 To lVisible
                            sVisible(i) = .VisibleSlicerItems(i).Name
                        Next i
                        SlicerItems = Join(sVisible, sDelimiter)
                    End If
                End If
            End If
        End With
    Else
        SlicerItems = SlicerName & " not found!"
    End If

End Function

它看起來是這樣的：