PowerPivot数据透视表切片器选择

时间:2016-08-26 17:42:40

标签: excel vba powerpivot

我在网上找到了几个可以捕获数据透视表切片器选择的UDF,但是,只有数据透视表基于Excel表格才能使用它们。 如果它是PowerPivot数据透视表(就像我的情况一样),它们就不起作用。

这篇文章PowerPivot Slicer selection based on cell value using VBA解释说,在使用PowerPivot数据透视表时,您需要访问SlicerCacheLevel对象,而不是SlicerCache。

如果有人可以帮助修改以下UDF以使用PowerPivot PivotTables切片器,那将是非常棒的,我想很多Excel用户会为你的帮助祷告。

我将在这里发布两个UDF及其来源: 第一个:'http://www.jkp-ads.com/Articles/slicers05.asp

Public Function GetSelectedSlicerItems(SlicerName As String) As String
    Dim oSc As SlicerCache
    Dim oSi As SlicerItem
    Dim lCt As Long
    On Error Resume Next
    Application.Volatile
    Set oSc = ThisWorkbook.SlicerCaches(SlicerName)
    If Not oSc Is Nothing Then
        For Each oSi In oSc.SlicerItems
            If oSi.Selected Then
                GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Name & ", "
                lCt = lCt + 1
            ElseIf oSi.HasData = False Then
                lCt = lCt + 1
            End If
        Next
        If Len(GetSelectedSlicerItems) > 0 Then
            If lCt = oSc.SlicerItems.Count Then
                GetSelectedSlicerItems = "All"
            Else
                GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2)
            End If
        Else
            GetSelectedSlicerItems = "No items selected"
        End If
    Else
        GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found"
    End If
End Function

第二个:https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev

Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant)
 ' Type Variant must be used for Optional Parameters for the IsMissing function to work below.
 Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items
 FblSlicerSelections = ""
 If IsMissing(Delimiter) Then Delimiter = " "
 If IsMissing(Wrap_Length) Then Wrap_Length = 40
 With ActiveWorkbook.SlicerCaches(Slicer_Name)
     For i = 1 To .SlicerItems.Count
         If .SlicerItems(i).Selected Then
             s = s + 1 ' Selected count increment
             If .SlicerItems(i).HasData Then
                 If Len(FblSlicerSelections) > r * Wrap_Length Then
                     FblSlicerSelections = FblSlicerSelections & vbCr & "  "
                     r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return)
                 End If
                 FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter
             End If
         End If
     Next i
     If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count
 End With
 FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter
 End Function

1 个答案:

答案 0 :(得分:0)

好的,恐慌。我设法将这两个功能改为现在使用来自外部源的切片器(例如PowerPivot)。我希望有人能从这些UDF中受益。

Public Function GetSelectedSlicerItems(SlicerName As String)As String ' http://www.jkp-ads.com/Articles/slicers05.asp     Dim oSc As SlicerCacheLevel' SlicerCache     Dim oSi As SlicerItem     Dim lCt As Long     On Error Resume Next     Application.Volatile

Set oSc = ThisWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1)

If Not oSc Is Nothing Then
    For Each oSi In oSc.SlicerItems
        If oSi.Selected Then
            GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Caption & ", " 'Initial code: oSi.Caption // There are 3 "choices": .Caption .Name .Value
            lCt = lCt + 1
        ElseIf oSi.HasData = False Then
            lCt = lCt + 1
        End If
    Next
    If Len(GetSelectedSlicerItems) > 0 Then
        If lCt = oSc.SlicerItems.Count Then
            GetSelectedSlicerItems = "All"
        Else
            GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2)
        End If
    Else
        GetSelectedSlicerItems = "No items selected"
    End If
Else
    GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found"
End If
End Function

第二个UDF:

Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant)
Application.Volatile
'https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev
 ' Type Variant must be used for Optional Parameters for the IsMissing function to work below.
 Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items
 FblSlicerSelections = ""
 If IsMissing(Delimiter) Then Delimiter = " "
 If IsMissing(Wrap_Length) Then Wrap_Length = 40

 With ActiveWorkbook.SlicerCaches(Slicer_Name).SlicerCacheLevels(1)

     For i = 1 To .SlicerItems.Count

         If .SlicerItems(i).Selected Then
             s = s + 1 ' Selected count increment
             If .SlicerItems(i).HasData Then
                 If Len(FblSlicerSelections) > r * Wrap_Length Then
                     FblSlicerSelections = FblSlicerSelections & vbCr & "  "
                     r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return)
                 End If
                 FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter
             End If
         End If
     Next i

     If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count
 End With

 FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter
 End Function
相关问题