使用VBA根据单元格日期更新Excel数据透视表

一、修改手动宏，读取单元格动态日期 #

把你原来的固定日期代码改成动态读取A5单元格的日期，同时统一处理所有日期项的显示/隐藏：

Sub Refresh_new_date()
    Dim targetDate As Date
    Dim pivotField As PivotField
    Dim pivotItem As PivotItem
    
    ' 读取指定单元格（A5）的日期，替换"你的工作表名称"为实际表名
    targetDate = ThisWorkbook.Sheets("你的工作表名称").Range("A5").Value
    
    Set pivotField = ActiveSheet.PivotTables("PivotTable1").PivotFields("Date")
    
    ' 先隐藏所有日期选项
    For Each pivotItem In pivotField.PivotItems
        pivotItem.Visible = False
    Next pivotItem
    
    ' 显示目标日期对应的选项（格式要和透视表内的日期字符串匹配）
    On Error Resume Next ' 避免目标日期不存在时触发错误
    pivotField.PivotItems(Format(targetDate, "mm/dd/yyyy")).Visible = True
    On Error GoTo 0
End Sub

注意事项： #

• 替换代码中的你的工作表名称为实际存放A5的工作表名称（比如Sheet1）
• 透视表中的日期格式要和Format(targetDate, "mm/dd/yyyy")一致，如果透视表用的是dd/mm/yyyy格式，就修改对应参数
• 若A5可能输入无效日期，可添加If IsDate(targetDate) Then判断，避免运行错误

二、添加自动触发功能 #

要实现A5日期更新时自动刷新，需要在对应工作表的Change事件中添加代码：

1. 打开VBA编辑器（按Alt+F11）
2. 在左侧工程窗口找到目标工作表，双击打开代码窗口
3. 在上方下拉菜单分别选择Worksheet和Change，粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当A5单元格内容变化时执行刷新
    If Not Intersect(Target, Me.Range("A5")) Is Nothing Then
        Refresh_new_date
    End If
End Sub

这样每次修改A5的日期，透视表就会自动刷新并只显示该日期的数据。

内容的提问来源于stack exchange，提问作者Miłosz Kraus