Excel VBA - 输入过滤器到数据透视表返回对象需要

Question

我有一些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 

Answer 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和作为Variant创建Pivotname3。

你分配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 

一两件事：有没有名为“规划月” PivotField存在于数据透视表？如果它不存在，您可能需要添加它，然后才能对其应用过滤器。

Answer 2

我没有看到对“W3”定义的东西。你有“ws3”等，但没有“w3”。是吗？

编辑： 如果您仍然收到错误，它可能有一个与“规划月”

Answer 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