Adicionar Seleções do Slicer à planilha em uma lista - Excel VBA

0

Eu tenho uma tabela dinâmica com um fatiador em que um usuário pode fazer várias seleções. Estou tentando listar os valores selecionados na segmentação para que eles possam ser unidos em outra célula usando CONCATENATE. Eu estou usando o código abaixo.

No momento, as células L5: L7 são preenchidas com a primeira seleção feita no slicer, mas nenhuma outra.

Eu fiz algumas pesquisas e encontrei uma possível solução com a função CUBESET, mas não consigo fazer isso funcionar na minha planilha. Daí a tentativa do VBA. Alguém sabe o que há de errado com isso?

    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
    
por user767772 29.09.2017 / 06:02

1 resposta

0

Aqui está uma função definida pelo usuário que você pode chamar diretamente da pasta de trabalho que faz isso para você e pode ser executada em qualquer tipo de fatiador, seja uma tabela dinâmica 'tradicional', uma tabela dinâmica OLAP / PowerPivot ou uma fatia de tabela . Basta colocar isso em um módulo de código padrão e, em seguida, na pasta de trabalho, digite o seguinte:

= 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

E aqui está como fica:

    
por 03.10.2017 / 20:59