macros自动select数据透视表filter下拉菜单中的最近date

我有一个自动刷新的报告,然后我有一些运行的macros来做各种事情。 目前一切工作正常,但是,我想写一个macros,自动select数据透视表中的最近date。 目前,我有以下代码:

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”这个date目前是最近的date,但是如果我在下周运行这个报告,那么上面的macros将会每次都select22/08/2017。 是否有一段代码总是select枢纽filter中的最近date?

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

编辑:

所以,我尝试了一个不同的解决scheme,它使用包含最近date的报告中的单元格引用。 我使用这个date来设置filter标准,然后for循环遍历数据透视表并将每个值设置为空,直到find匹配项为止:

 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属性。 有人能帮助我吗?

最亲切的问候

请给这个尝试…

 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 

如果您不确定您的标准date是否在透视筛选器项目中可用,您可以尝试这样的事情。

 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 

对于任何有兴趣或未来可能需要这样做的人来说,我提出的解决scheme是:

 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中的值只是最近的date。 这现在完美。