问题
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
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?
Thanks.
Pivot Fields:
Pivot source data, maybe this format could be why?
filterDate value based on Christians Code:
回答1:
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 this:
With Sheets("Details").PivotTables("PivotTable1").PivotFields("Period")
.ClearAllFilters
.PivotFilters.Add Type:=xlSpecificDate, Value1:=Sheets("Input").Range("H2").Value2
End With
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.
EDIT
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
EDIT 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
EDIT 3
Based on updated question:
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
回答2:
The filter items in the pivot table are characters, not values. Therefore, under the condition that the cell format type is the same as the field format type of the pivot table, you must obtain the character, not the cell value(range("h2").Text not range("h2").value).
Sub RefreshPivots()
Dim Ws As Worksheet
Dim PT As PivotTable
Dim PF As PivotField
Dim Temp As String
Temp = Sheets("Input").Range("H2").Text '<~~ it is string not value
Set Ws = Sheets("Details")
Set PT = Ws.PivotTables("PivotTable1")
Set PF = PT.PivotFields("Period")
PT.PivotCache.Refresh
PF.ClearAllFilters
'*** if your source type is date
'PF.PivotFilters.Add Type:=xlSpecificDate, Value1:=Temp
'but your source data type is string
PF.PivotFilters.Add Type:=xlCaptionEquals, Value1:=Temp
End Sub
来源：https://stackoverflow.com/questions/63890590/vba-application-defined-or-object-error-changing-pivot-filter