vba - vba中的数据透视表过滤器无法正常工作

Question

我有这个代码来选择一个日期并更改数据透视表的过滤器以反射(reflect)相关信息。但有时这有效，有时它给了我

Error 1004 Application-defined or Object-defined error

这让我发疯，我不知道发生了什么，特别是因为这段代码有效，然后它没有，没有任何改变。

Dim DataVenda As Date
DataVenda = InputBox("Data de Vendas (dd/mm):")

ActiveSheet.Range("B1").Select
With Selection
    ActiveSheet.PivotTables("DinTblResumoDiario").PivotFields("Data:").ClearAllFilters
    ActiveSheet.PivotTables("DinTblResumoDiario").PivotFields("Data:").CurrentPage = DataVenda
End With

错误在最后一条命令中: ActiveSheet.PivotTables("DinTblResumoDiario").PivotFields("Data:").CurrentPage = DataVenda

Answer 1

如上所述，最好避免使用 ActiveSheet , Select和 Selection , 并改用完全限定的对象。

下面的代码我使用了 PivotTable 类型的对象定义和设置数据透视表，也适用于 PivotField .

我还添加了另一种类型的 InputBox强制用户在 Date 中输入一个值格式。

备注 :InputBox 中选择的值有可能在数据透视表中的任何地方都找不到，所以我在下面的代码中添加了一种检查它的方法。

代码

Option Explicit

Sub OccupancyPivot()

Dim wsSheet             As Worksheet
Dim PT                  As PivotTable
Dim PTFld               As PivotField
Dim DataVenda           As Date

' use this type of Input Box to force the user to enter a date format
DataVenda = Application.InputBox("Data de Vendas (dd/mm):", "Select date", FormatDateTime(Date, vbShortDate), Type:=1)       

Set wsSheet = ThisWorkbook.Worksheets("Sheet1") ' <-- modify "Sheet1" to your Pivot's sheet name

On Error Resume Next
Set PT = wsSheet.PivotTables("DinTblResumoDiario") ' set the PivotTable    
On Error GoTo 0
If PT Is Nothing Then ' "DinTblResumoDiario" Pivot Table doesn't exist
    MsgBox "Pivot Table 'DinTblResumoDiario' doesn't exist!"
Else ' "DinTblResumoDiario" Pivot Table exists
    Set PTFld = PT.PivotFields("Data:") ' <-- set the pivot field    
    PTFld.ClearAllFilters

    On Error Resume Next
    PTFld.CurrentPage = DataVenda ' Error line if DataVenda isn't valid (no value inside Pivot Table matches it)
    If Err.Number <> 0 Then
        MsgBox "Filter Didn't get applied, no value inside Pivot Table matches your selection"
    End If
    On Error GoTo 0
End If

End Sub