Excel 宏自动选择透视表筛选器下拉列表中的最近日期

我有一个每周自动刷新的报告，然后我有一些宏运行，可以做各种事情。目前一切正常，但是，我想编写一个宏，自动选择数据透视表中的最近日期。目前，我有以下代码：

Sub RefreshPivot()
'
' RefreshPivot Macro
'

'
    Sheets("Pivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
        = "22/08/2017"
End Sub

日期“2017年8月22日”是当前最新的日期，但如果我下周运行报告，上述宏将每次选择2017年8月22日。是否有一段快速代码始终选择透视过滤器中的最近日期

欢迎任何帮助

编辑：

因此，我尝试了另一种解决方案，即在包含最近日期的报告中使用单元格引用。我使用此日期设置筛选条件，然后for循环遍历pivot数据并将每个值设置为空，直到找到匹配：

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period


Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As String
Dim pi As PivotItem

    'Set the variables
    sSheetName = "Pivot"
    sPivotName = "PivotTable1"
    sFieldName = "ExtractDate"
    'sFilterCrit = "22/08/2017" --most recent date
    sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

    With ThisWorkbook.Worksheets(sSheetName).PivotTables(sPivotName).PivotFields(sFieldName)
        'Clear all filter of the pivotfield
        .ClearAllFilters

        'Loop through pivot items of the pivot field
        'Hide or filter out items that do not match the criteria
        For Each pi In .PivotItems
            If pi.Name <> sFilterCrit Then
                pi.Visible = False
            End If
        Next pi

    End With

End Sub

子过滤器_PivotField（）
'说明：筛选特定日期或期间的数据透视表
暗表名称为字符串
Dim sPivotName作为字符串
Dim sFieldName作为字符串
Dim sFilterCrit作为字符串
Dim pi作为数据透视项
'设置变量
sSheetName=“枢轴”
sPivotName=“数据透视表1”
sFieldName=“提取日期”
'sFilterCrit=“22/08/2017”--最近日期
sFilterCrit=此工作簿。工作表（“透视”）。范围（“C4”）。值
使用此工作簿。工作表（sSheetName）。数据透视表（sPivotName）。数据透视字段（sFieldName）
'清除数据透视字段的所有筛选器
.ClearAllFilters
'循环遍历数据透视字段的数据透视项
'隐藏或筛选出与条件不匹配的项目
对于.PivotItems中的每个pi
如果pi.Name为sFilterCrit，则
pi.Visible=False
如果结束
下一个pi
以
端接头

但是，当我运行此操作时，会出现以下错误：

运行时错误“1004”：无法设置PivotItem类的Visible属性

---

有人能帮我吗

对于任何有兴趣或将来可能需要这样做的人，我提出了以下解决方案：

Sub RefreshPivot()
'
' RefreshPivot Macro
'

'
    Sheets("Pivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
        = ThisWorkbook.Worksheets("Pivot").Range("C4").Value
End Sub

---

单元格C4中的值只是最近的日期。这项功能现在非常有效。

对于任何有兴趣或将来可能需要这样做的人，这里是我提出的解决方案：

Sub RefreshPivot()
'
' RefreshPivot Macro
'

'
    Sheets("Pivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
        = ThisWorkbook.Worksheets("Pivot").Range("C4").Value
End Sub

---

单元格C4中的值只是最近的日期。现在这个很好用。

请尝试一下

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters


For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

如果您不确定您的条件日期是否在透视过滤器项目中可用，您可以尝试以下操作

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim dict
'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters

Set dict = CreateObject("Scripting.Dictionary")
For Each pi In pf.PivotItems
    dict.Item(CDbl(DateValue(pi))) = ""
Next pi

If Not dict.exists(sFilterCrit) Then
    MsgBox "The criteria date is missing in Pivot Filter Items.", vbExclamation
    Exit Sub
End If

For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

---

请试试这个

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters


For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

如果您不确定您的条件日期是否在透视过滤器项目中可用，您可以尝试以下操作

Sub Filter_PivotField()
'Description: Filter a pivot table for a specific date or period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As Double
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim dict
'Set the variables
sSheetName = "Pivot"
sPivotName = "PivotTable1"
sFieldName = "ExtractDate"
'sFilterCrit = "22/08/2017" --most recent date
sFilterCrit = ThisWorkbook.Worksheets("Pivot").Range("C4").Value

Set pt = ThisWorkbook.Worksheets("Pivot").PivotTables(sPivotName)
Set pf = pt.PivotFields(sFieldName)
pf.ClearAllFilters

Set dict = CreateObject("Scripting.Dictionary")
For Each pi In pf.PivotItems
    dict.Item(CDbl(DateValue(pi))) = ""
Next pi

If Not dict.exists(sFilterCrit) Then
    MsgBox "The criteria date is missing in Pivot Filter Items.", vbExclamation
    Exit Sub
End If

For Each pi In pf.PivotItems
    If CDbl(DateValue(pi)) = sFilterCrit Then
        pi.Visible = True
    Else
        pi.Visible = False
    End If
Next pi
End Sub

---

实际上，我并不需要您编写的代码，因为我的小代码运行良好。尽管如此，我还是很感激你的帮助。实际上，我并不需要你编写的代码，因为我的小代码工作得很好。尽管如此，我还是很感谢您的帮助。上述方法仅适用于页面字段，即数据透视表字段对话框“过滤器”区域中显示的字段。但从好处看，它很快：像您这样使用.CurrentPage方法要比更改每个.PivotItem的.visible状态快得多，正如我在中所概述的。如果你想要一个能在非页面字段上同样快速地工作的解决方案，请查看（这种方法还可以让你定义日期周期）。感谢你的建议-我一直在研究非筛选选项，因此这将有助于今后的工作。非常感谢：-）上述方法仅适用于页面字段，即数据透视表字段对话框“过滤器”区域中显示的字段。但从好处看，它很快：像您这样使用.CurrentPage方法要比更改每个.PivotItem的.visible状态快得多，正如我在中所概述的。如果你想要一个能在非页面字段上同样快速地工作的解决方案，请查看（这种方法还可以让你定义日期周期）。感谢你的建议-我一直在研究非筛选选项，因此这将有助于今后的工作。非常感谢：-）