我在网上找到了几个可以捕获数据透视表切片器选择的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
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
答案 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