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

日期＆＃34; 22/08/2017＆＃34;目前是最近的日期，但如果我下周运行报告，上面的宏将每次都选择22/08/2017。是否有一段快速的代码总是在数据透视过滤器中选择最近的日期？

欢迎任何帮助。

编辑：

所以，我尝试了另一种解决方案，它在我的报告中使用包含最新日期的单元格引用。我使用此日期来设置过滤条件，然后for循环遍历透视数据并将每个值设置为空白，直到找到匹配项：

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

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

运行时错误＆＃39; 1004＆＃39;：无法设置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中的值只是最近的日期。这现在完美无缺。

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

2 个答案: