VBA，应用程序定义或对象错误，更改数据透视筛选器 [英] VBA, Application-defined or Object Error, changing Pivot Filter

问题描述

我正在尝试使用基于单元格的vba更改枢轴过滤器.我在第二行代码中收到错误 Application-defined或Object Error .

I am trying to change the pivot filter using vba based on a cell. I get error Application-defined or Object Error on my second line of code.

Sub RefreshPivots()

Sheets("Details").PivotTables("PivotTable1").PivotCache.Refresh
Sheets("Details").PivotTables("PivotTable2").PivotCache.Refresh


temp = Sheets("Input").Range("H2")
Sheets("Details").PivotTables("PivotTable1").PivotFields("Period").PivotFilters.Add Type:=xlCaptionEquals, Value1:=temp

  

End Sub

我正在尝试切换到 Sheets("Input").Range("H2")中的日期，所以如果我在该单元格中有9月10/20，希望枢轴更新到该位置.

I am trying to switch to a date that I have in Sheets("Input").Range("H2") So if I have Sept 10/20 in this cell, I want the pivot to update to that.

有人知道我在做什么错吗?

Does anyone know what I am doing wrong?

谢谢.

数据透视字段:

数据源数据，也许这种格式可能是为什么?

Pivot source data, maybe this format could be why?

filteredDate值基于基督教法规:

推荐答案

首先，我认为 Period 字段必须位于的 Rows 部分下数据透视表字段窗格(单独或在其他字段中-顺序无关紧要):

First of all I think the Period field must be under the Rows section of the PivotTable Fields pane (alone or among other fields - order doesn't matter):

然后您需要替换以下内容:

Then you would need to replace this:

temp = Sheets("Input").Range("H2")
Sheets("Details").PivotTables("PivotTable1").PivotFields("Period").PivotFilters.Add Type:=xlCaptionEquals, Value1:=temp

与此:

With Sheets("Details").PivotTables("PivotTable1").PivotFields("Period")
    .ClearAllFilters
    .PivotFilters.Add Type:=xlSpecificDate, Value1:=Sheets("Input").Range("H2").Value2
End With

---

您可能需要在运行代码之前进行一些检查，因为工作表名称以及数据透视表名称可以更改，等等.另外，也可以使用 ThisWorkbook.Worksheets 代替 Sheets .这样，您将不会引用ActiveWorkbook，而是引用正在运行代码的工作簿.

---

You might want to do some checks before running your code because sheet names can change as well as pivot table names and so on. Also instead of Sheets maybe use ThisWorkbook.Worksheets. This way you are not reffering to the ActiveWorkbook but to the Workbook where the code is running.

编辑

这里的代码可以进行上述检查:

Here's code that does some checks like mentioned above:

Option Explicit

Sub RefreshPivots()
    Dim pivTable1 As PivotTable
    Dim pivTable2 As PivotTable
    
    Set pivTable1 = GetPivotTable(ThisWorkbook, "Details", "PivotTable1")
    If pivTable1 Is Nothing Then
        'Do Something. Maybe Exit or display a MsgBox
    End If
    pivTable1.PivotCache.Refresh
    
    Set pivTable2 = GetPivotTable(ThisWorkbook, "Details", "PivotTable2")
    If pivTable2 Is Nothing Then
        'Do Something. Maybe Exit or display a MsgBox
    End If
    pivTable2.PivotCache.Refresh
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        'Do Something. Maybe Exit or display a MsgBox
    End If
    On Error GoTo 0
    
    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Inputs").Range("H2").Value2
    If Err.Number <> 0 Then
        'Do Something. Maybe Exit or display a MsgBox
    Else
        Select Case VarType(filterDate)
        Case vbDouble
            'Maybe check if serial number is valid
        Case vbString
            filterDate = CDbl(CDate(filterDate))
        Case Else
            'Maybe show a MsgBox
            Exit Sub
        End Select
    End If
    On Error GoTo 0
    
    With periodField
        .ClearAllFilters
        .PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
    End With
End Sub

Private Function GetPivotTable(ByVal sourceBook As Workbook _
    , ByVal wSheetName As String _
    , ByVal pivotName As String _
) As PivotTable
    On Error Resume Next
    Set GetPivotTable = sourceBook.Worksheets(wSheetName).PivotTables(pivotName)
    On Error GoTo 0
End Function

编辑2

我简化了过滤日期检查，并添加了一些代码来代替可能"评论:

I've simplified the filter date check and added some code instead of the "Maybe" comments:

Sub RefreshPivots()
    Dim pivTable1 As PivotTable
    Dim pivTable2 As PivotTable
    
    Set pivTable1 = GetPivotTable(ThisWorkbook, "Details", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    Set pivTable2 = GetPivotTable(ThisWorkbook, "Details", "PivotTable2")
    If pivTable2 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable2.PivotCache.Refresh
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    On Error GoTo 0
    
    'Maybe check if date is within a certain range
'    If filterDate < minDate Or filterDate > maxDate Then
'        MsgBox "Invalid Date", vbInformation, "Cancelled"
'        Exit Sub
'    End If

    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Inputs").Range("H2").Value2
    If VarType(filterDate) = vbString Then filterDate = CDbl(CDate(filterDate))
    If Err.Number <> 0 Or VarType(filterDate) <> vbDouble Then
        MsgBox "Missing/Invalid Filter Date", vbInformation, "Cancelled"
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
    
    With periodField
        .ClearAllFilters
        .PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
    End With
End Sub

编辑3

基于更新后的问题:

Option Explicit

Sub RefreshPivots()
    Dim pivTable1 As PivotTable
    Dim pivTable2 As PivotTable
    
    Set pivTable1 = GetPivotTable(ThisWorkbook, "Details", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    Set pivTable2 = GetPivotTable(ThisWorkbook, "Details", "PivotTable2")
    If pivTable2 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable2.PivotCache.Refresh
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    periodField.ClearAllFilters
    
    'Maybe check if date is within a certain range
'    If filterDate < minDate Or filterDate > maxDate Then
'        MsgBox "Invalid Date", vbInformation, "Cancelled"
'        Exit Sub
'    End If

    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Inputs").Range("H2").Value2
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Missing Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try String first
    If VarType(filterDate) = vbString Then
        periodField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=filterDate
        If Err.Number = 0 Then Exit Sub
        
        filterDate = CDbl(CDate(filterDate))
        Err.Clear
    End If
    
    If VarType(filterDate) <> vbDouble Then
        MsgBox "Invalid Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try Date (as Double data type)
    periodField.PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Could not apply filter", vbInformation, "Cancelled"
        Exit Sub
    End If
End Sub

Private Function GetPivotTable(ByVal sourceBook As Workbook _
    , ByVal wSheetName As String _
    , ByVal pivotName As String _
) As PivotTable
    On Error Resume Next
    Set GetPivotTable = sourceBook.Worksheets(wSheetName).PivotTables(pivotName)
    On Error GoTo 0
End Function

这篇关于VBA，应用程序定义或对象错误，更改数据透视筛选器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！