Excel VBA按指定日期隐藏切片器无关选项按钮

需要配置工作表，让用户在单元格$D$5输入日期后，关联数据透视表的订单编号切片器仅显示该日期发货的订单按钮，移除无关选项。现有未结订单数据集、对应数据透视表及订单编号切片器，当前代码仅能实现切片项的选择/取消选择，无法隐藏（移除）不符合条件的按钮，尝试SlicerCache.Selected = TRUE or FALSE无效，推测需使用SlicerCache.VisibleSlicerItems但不知正确用法。

现有代码如下：

Sub FilterSlicer()

'Declare Variables
Dim xlApp As Application
Dim xlActiveBook As Workbook
Dim xlActiveSheet As Worksheet

Dim OpenOrderTable As ListObject

Dim sl As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem

'Grab Application
Set xlApp = Application
'Grab Active book
Set xlActiveBook = xlApp.ThisWorkbook


'Grab OpenOrder Slicer Caches
Set sc = xlActiveBook.SlicerCaches("Slicer_Order_Number")


'Update Slicer Caches values based on the date picked on the sheet.

'First - stop pivot table from refreshing after each pivot item is changed
For Each pt In sc.PivotTables
    pt.ManualUpdate = True
Next pt

Debug.Print sc.SlicerItems(1).Name


'Second - update slicer item visibility

'One slicer must always remain visible so make first item visible then check if it should be at the end
sc.SlicerItems(1).Selected = True


'Unselected all other slicer items
For i = 2 To sc.SlicerItems.Count
    If sc.SlicerItems(i).Selected Then sc.SlicerItems(i).Selected = False
Next i

'Remove specific slicer buttons based on user entry
'***THIS IS WHERE I WANT TO ADD CODE TO REMOVE SLICER BUTTONS***




'Allow pivot table to update
For Each pt In sc.PivotTables
    pt.ManualUpdate = False
Next
    


End Sub

要实现“移除切片器按钮”的效果，核心是设置不符合条件的切片项为不可见，而非单纯的选择/取消选择。你需要通过订单编号关联数据源中的发货日期，判断是否匹配$D$5的输入，再调整SlicerItem.Visible属性。

核心修改逻辑 #

1. 读取并验证$D$5的目标日期；
2. 遍历切片器所有项，通过订单编号在数据源中查找对应发货日期；
3. 匹配日期的切片项设为可见，其余设为不可见；
4. 强制保留至少一个可见项（Excel不允许所有切片项隐藏），无匹配项时给出提示。

修改后的完整代码 #

Sub FilterSlicerByDate()
    Dim sc As SlicerCache
    Dim si As SlicerItem
    Dim targetDate As Date
    Dim ws As Worksheet
    Dim lo As ListObject
    Dim matchRow As Range
    Dim hasVisibleItem As Boolean
    
    ' 替换为你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 读取目标日期并验证
    On Error Resume Next
    targetDate = ws.Range("D5").Value
    On Error GoTo 0
    If IsEmpty(targetDate) Then
        MsgBox "请在D5单元格输入有效日期", vbExclamation
        Exit Sub
    End If
    
    ' 获取切片器缓存
    Set sc = ThisWorkbook.SlicerCaches("Slicer_Order_Number")
    ' 替换为你的未结订单表格名称
    Set lo = ws.ListObjects("OpenOrderTable")
    
    ' 禁用透视表自动更新提升效率
    For Each pt In sc.PivotTables
        pt.ManualUpdate = True
    Next pt
    
    hasVisibleItem = False
    
    ' 遍历所有切片项设置可见性
    For Each si In sc.SlicerItems
        ' 在数据源中查找当前订单编号
        Set matchRow = lo.ListColumns("Order_Number").Range.Find(si.Name, LookIn:=xlValues, LookAt:=xlWhole)
        If Not matchRow Is Nothing Then
            ' 替换为你的发货日期列名称
            If lo.ListColumns("Ship_Date").Range(matchRow.Row - lo.HeaderRowRange.Row + 1).Value = targetDate Then
                si.Visible = True
                hasVisibleItem = True
            Else
                si.Visible = False
            End If
        Else
            ' 数据源中不存在的订单直接隐藏
            si.Visible = False
        End If
    Next si
    
    ' 处理无匹配项的情况
    If Not hasVisibleItem Then
        sc.SlicerItems(1).Visible = True
        MsgBox "该日期下无待发货订单", vbInformation
    End If
    
    ' 启用透视表更新
    For Each pt In sc.PivotTables
        pt.ManualUpdate = False
    Next pt
End Sub

注意事项 #

• 务必替换代码中标记的工作表名称、表格名称、订单编号列名、发货日期列名为你实际使用的名称；
• SlicerItem.Visible = False会直接隐藏切片器中的对应按钮，达到“移除”的效果；
• 加入了日期有效性检查和无匹配项提示，避免运行时错误；
• 使用Find方法关联订单与日期，确保判断逻辑准确。

内容的提问来源于stack exchange，提问作者Daryan