VBA 更改切片器选择当前选定的项目
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20616369/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA to change slicer selection current selected item
提问by whytheq
The below behaves quite strangely.
It's aim is to leave the slicer with only the item specified (in this case "Smith") with all other names not selected.
Most of the time it works but sometimes more than one item will be left selected.
下面的行为很奇怪。
它的目的是让切片器只保留指定的项目（在本例中为“Smith”），而不选择所有其他名称。
大多数情况下它可以工作，但有时会留下多个项目。
What is wrong with the below and how do I achieve the required behaviour?
下面有什么问题，我如何实现所需的行为？
Sub myRoutine()
unselectAllBut "Slicer_InitialAcc_Surname", "me"
End Sub
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim si As Object
For Each si In ActiveWorkbook.SlicerCaches(slicerName).SlicerItems
si.Selected = (si.Caption = newSelection)
Next si
End Sub
Second attempt which doesn't work either:
第二次尝试也不起作用：
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
Maybe the data is causing the problem. It looks like the following:
也许是数据导致了问题。它看起来像下面这样：
EDIT
编辑
The following seems to work. I select all items first which seems like over-kill:
以下似乎有效。我首先选择所有似乎过分的项目：
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = True
Next i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
回答by Tamas Karacsony
A bit faster way:
更快一点的方法：
- first set the new selection
- second clear all others
- 首先设置新选择
- 第二个清除所有其他人
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Caption = newSelection Then .SlicerItems(i).Selected = True: Exit For
Next i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> newSelection Then .SlicerItems(i).Selected = False
Next i
End With
End Sub
