宏以自动选择数据透视表过滤器下拉列表中的最新日期

Question

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

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

日期“22/08/2017”是目前最近的日期，但如果我下周运行报告，上面的宏将每次都选择22/08/2017。是否有快速的代码总是选择透视滤镜中的最新日期？

任何帮助都是最受欢迎的。

编辑：

所以，我尝试了一种不同的解决方案，它在我的报告中使用包含最新日期的单元格引用。我使用此日期来设置过滤条件，然后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

但是，当我运行它时，我收到以下错误：

运行时错误“1004”：无法设置PivotItem类的Visible属性。有人能帮助我吗？

最亲切的问候

Answer 1

请试一试......

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

Answer 2

对于任何有兴趣或可能需要在将来执行此操作的人，以下是我提出的解决方案：

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中的值只是最近的日期。这现在完美地运作。