VBA制作范围（“K1”）=切片器项目值

Question

我有一个搜索框 (K1)，它将搜索切片器项目并显示适当的图表，但是，如果用户选择使用切片器来显示特定图表，K1 中的值将与切片器项目不匹配。

它们匹配的唯一时间是用户使用搜索框时。我在单元格 O1 中创建了一个公式，它返回 1（如果它们匹配）或返回 0（如果它们不匹配），然后尝试将 K1 = 设置为项目值（代码的引用部分）的不同变体。

请查看我的仪表板图片链接以供参考。

我对 VBA 非常陌生，因此非常感谢任何 ELI5 答案。

Sub SearchPivots()


Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

On Error GoTo 28


'Find Pivot Table
Set pt = Worksheets("Overall Pivot").PivotTables("NAMERPM")

Set Field = pt.PivotFields("Filter Field")
NewCat = Worksheets("Resource Dashboard").Range("K1").Value

Application.Calculation = xlCalculationAutomatic

'This updates and refreshes the PIVOT table
With pt
    Field.ClearAllFilters
    Field.CurrentPage = NewCat
    pt.RefreshTable
End With

'With Field
'    If Range("O1").Value = 0 Then
'        Range("K1") = Field.CurrentPage.Value
'    End If
'End With

    Exit Sub
28:
    MsgBox "That project number is not listed.  Please check the project number and try again."

Application.ScreenUpdating = True
Application.DisplayStatusBar = True




End Sub

Answer 1

Tony，在此链接中，您将找到一个无需 VBA 即可完成此操作的 hack。 http://dailydoseofexcel.com/archives/2014/08/16/sync-pivots-from-dropdown/

Answer 2

我不确定我是否理解这个问题，切片器如何控制显示哪个图表，但下面的代码将通过可透视的更改事件获取选定的切片器项目（但他们当然可以选择很多）

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim sItem As Excel.SlicerItem
Dim msg As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    nextrow = 0
    For i = 1 To Target.Slicers.Count

        msg = Target.Slicers(i).Name & vbNewLine

        For Each sItem In Target.Slicers(i).SlicerCache.VisibleSlicerItems

            nextrow = nextrow + 1
            msg = msg & vbTab & sItem.Name & vbNewLine
        Next sItem

        MsgBox msg
    Next i
End Sub

按名称引用特定切片器

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim sItem As Excel.SlicerItem
Dim nextrow As Long
Dim i As Long
Dim msg As String

    nextrow = 0

    With Target.Slicers("Filter_Field")

        msg = .Name & vbNewLine

        For Each sItem In .SlicerCache.VisibleSlicerItems

            nextrow = nextrow + 1
            msg = msg & vbTab & sItem.Name & vbNewLine
        Next sItem

        MsgBox msg
    End With
End Sub