我正在尝试使用基于单元格的 vba 更改枢轴过滤器。
我收到错误 Application-defined or Object Error
在我的第二行代码上。
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 日,我希望枢轴更新到那个。有谁知道我做错了什么?
谢谢。
枢轴字段:
透视源数据,也许这种格式可能是为什么?
filterDate 值基于基督徒代码:
最佳答案
首先我认为Period
字段必须位于“数据透视表字段” Pane 的“行”部分下(单独或在其他字段中 - 顺序无关紧要):
然后你需要替换这个:
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
您可能需要在运行代码之前进行一些检查,因为工作表名称以及数据透视表名称等可能会发生变化。也代替
Sheets
也许使用 ThisWorkbook.Worksheets
.这样,您不会引用 ActiveWorkbook,而是引用运行代码的工作簿。编辑
这是执行上述检查的代码:
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 我简化了过滤日期检查并添加了一些代码而不是“也许”注释:
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
关于excel - VBA,应用程序定义或对象错误,更改透视筛选器,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/63890590/