VBA to make range("K1") =切片器项值

Question

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

只有当用户使用搜索框时，它们才会匹配。我在单元格O1中创建了一个公式，如果它们匹配，则返回1(如果它们匹配)，如果它们不匹配，则返回0，然后尝试使K1 = to item value的不同变体(代码的引号部分)。

请参阅我的仪表板图像链接以供参考。

​

​

我对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的情况下做到这一点。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