Excel VBA - 将过滤器输入数据透视表返回需要的对象答案

【问题标题】：Excel VBA - Entering Filter into Pivot Table returning Object RequiredExcel VBA - 将过滤器输入数据透视表返回需要的对象
【发布时间】：2014-10-27 04:53:18
【问题描述】：

我有一些 VBA 代码设置为查找动态（变化的）数据表，然后代码更改范围以适应数据透视表，并根据新范围刷新数据透视表。

代码一直有效，直到到达需要应用过滤器的部分。我在名为 PivotFilter 的字符串下声明了一个日期值，当代码应用过滤器时，我收到运行时错误 1004 - 应用程序定义或对象定义错误

过去两个小时我一直在试图解决这个问题，但似乎无法修复它，我试图将字符串更改为一个范围，这也不起作用。有什么建议吗？

编辑修复了错误部分的错字，我仍然收到应用程序定义或对象定义错误

Sub PortfolioDataLoad()

Dim wb1 As Workbook
Dim ws1, ws2, ws3, ws4, ws5 As Worksheet
Dim r1, r2, r3 As Range
Dim StartPoint, DataRange As Range
Dim PivotName, Pivotname2, Pivotname3, Pivotname4 As String
Dim Datefrom, Dateto As Range
Dim PivotFilter As String


PivotFilter = Worksheets("Configuration").Range("B1")

PivotName = "PivotTable3"
Pivotname2 = "PivotTable4"
Pivotname3 = "PivotTable5"
Pivotname4 = "PivotTable1"

Application.StatusBar = "Transforming data into report graphs..."

'Set Variables Here

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Control Sheet")
Set ws2 = wb1.Sheets("Program Data")
Set ws3 = wb1.Sheets("Configuration")
Set ws4 = wb1.Sheets("Overview")


If ws1.Visible = False Then
   ws1.Visible = True
End If

'Dynamically Retrieve Data from Program Data
Set StartPoint = ws2.Range("A1")
Set DataRange = ws2.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = ws2.Name & "!" & _
       DataRange.Address(ReferenceStyle:=xlR1C1)

If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
    MsgBox "One of your data columns in the 'Program Data' tab has a blank heading." & vbNewLine _
      & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
    Exit Sub
 End If

'Change Pivot Range to Cache set above
ws3.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname2).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname3).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname4).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)


'Refresh Tables
ws3.PivotTables(PivotName).RefreshTable
ws3.PivotTables(Pivotname2).RefreshTable
ws3.PivotTables(Pivotname3).RefreshTable
ws3.PivotTables(Pivotname4).RefreshTable


'Set Date in Pivot Table Filter - Results in Run-time error '424': Object Required

ws3.PivotTables(PivotName).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

ws3.PivotTables(Pivotname2).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

ws3.PivotTables(Pivotname4).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

End Sub

【问题讨论】：

标签： vba excel

【解决方案1】：

我认为你有一个错字，w3 应该是 ws3。我相信台词

w3.PivotTables(PivotName).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

w3.PivotTables(Pivotname2).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

w3.PivotTables(Pivotname4).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

应该是

ws3.PivotTables(PivotName).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

ws3.PivotTables(Pivotname2).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

ws3.PivotTables(Pivotname4).PivotFields("Planning Month").PivotFilters.Add _
Type:=xlBeforeOrEqualTo, Value1:=PivotFilter

另外，请注意 NewRange 未定义。

使用Option Explicit 可以帮助找到这些。你可以阅读更多关于它的信息here。

请注意，当您在一行中定义多个项目时，实际上只有最后一个变量是使用指定类型定义的。例如：

Dim PivotName, Pivotname2, Pivotname3, Pivotname4 As String

导致变量Pivotname4 创建为String，但变量PivotName、Pivotname2 和Pivotname3 创建为Variant。

您将String 值分配给PivotName、Pivotname2 和Pivotname3，因此如果您在调试时查看项目类型，您会看到它们是Variant/String。看起来应该没问题，但这可能是个问题。

您可以尝试更改您的 Dim 语句以将变量类型显式设置为 String，正如我认为的那样。例如：

Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim Pivotname2 As String
Dim Pivotname3 As String
Dim Pivotname4 As String
Dim Datefrom As Range
Dim Dateto As Range
Dim PivotFilter As String
Dim NewRange As Range

还有一件事：名为“Planning Month”的PivotField 是否存在于数据透视表中？如果它不存在，您可能需要先添加它，然后才能对其应用过滤器。

【讨论】：

抱歉，我刚刚纠正了那个错字，但我仍然遇到应用程序定义或对象定义错误
谢谢您，我已将声明更改为更明确，就像您在上面显示的那样，我的数据透视表的过滤器中有一个计划月份值，但它仍然显示相同的错误。可能是代码引用了具有特定日期格式 dd/mm/yy 的单元格值吗？（澳大利亚日期系统）

【解决方案2】：

我没有看到为“w3”定义的任何内容。您有“ws3”和其他人，但没有“w3”。是这样吗？

编辑：如果您仍然收到错误消息，则“计划月份”可能存在问题

【讨论】：

【解决方案3】：

感谢大家对此的帮助，问题似乎是日期值未被识别为对象，因此我不得不以另一种方式执行此操作。我创建了一个循环来对照“控制表”中的日期检查数据表中的值。如果它们小于或等于日期，则值为“包含”，否则为“不包含”。然后将过滤器设置为“包含”。代码如下

Private Sub WorkSheet_Change(ByVal Target As Range)
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim StartPoint As Range
Dim DataRange As Range
Dim NewRange As String
Dim PivotName As String
Dim Pivotname2 As String
Dim Pivotname3 As String
Dim Pivotname4 As String
Dim Datefrom As Range
Dim Dateto As Range
Dim PivotFilter As String

PivotFilter = ThisWorkbook.Worksheets("Overview").Range("Z2")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PivotName = "PivotTable3"
Pivotname2 = "PivotTable4"
Pivotname3 = "PivotTable5"
Pivotname4 = "PivotTable1"

If Not Intersect(Target, Range("Z2:Z2")) Is Nothing Then
  If TargetVal <> Target Then
Application.StatusBar = "Transforming data into report graphs..."

'Set Variables Here

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Control Sheet")
Set ws2 = wb1.Sheets("Program Data")
Set ws3 = wb1.Sheets("Configuration")
Set ws4 = wb1.Sheets("Overview")


If ws1.Visible = False Then
   ws1.Visible = True
End If

If ws2.Visible = False Then
   ws2.Visible = True
End If

'Dynamically Retrieve Data from Program Data

ws2.Select
ws2.Range("H2").Select
  Do Until IsEmpty(Selection)
  If ActiveCell.Value <= PivotFilter Then
     ActiveCell.Offset(0, 28).Value = "Include"
     Else
     ActiveCell.Offset(0, 28).Value = "Dont Include"
  End If
ActiveCell.Offset(1, 0).Select
Loop

Set StartPoint = ws2.Range("A1")
Set DataRange = ws2.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = ws2.Name & "!" & _
       DataRange.Address(ReferenceStyle:=xlR1C1)

If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
    MsgBox "One of your data columns in the 'Program Data' tab has a blank heading." & vbNewLine _
    & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
    Exit Sub
End If


ws3.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname2).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname3).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

ws3.PivotTables(Pivotname4).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)



ws3.PivotTables(PivotName).RefreshTable
ws3.PivotTables(Pivotname2).RefreshTable
ws3.PivotTables(Pivotname3).RefreshTable
ws3.PivotTables(Pivotname4).RefreshTable

ws3.PivotTables(PivotName).PivotFields("Planning Period"). _
CurrentPage = "Include"

ws3.PivotTables(Pivotname4).PivotFields("Planning Period"). _
CurrentPage = "Include"

ws3.PivotTables(Pivotname2).PivotFields("Planning Period"). _
CurrentPage = "Include"

ThisWorkbook.Worksheets("Overview").Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
Exit Sub

【讨论】：