Excel VBA – inputfilter到数据透视表返回对象必需

我有一些VBA代码被设置为查找一个dynamic(改变)的数据表,然后代码更改范围以适应数据透视表,并刷新基于新范围的数据透视表。

代码运行,直到到达需要应用filter的部分。 我有一个date值,我已经声明一个string称为PivotFilter,当代码去应用filter,我得到一个运行时错误1004 – 应用程序定义或对象定义的错误

我一直试图弄清楚了这两个小时,似乎无法解决这个问题,我试图将string更改为一个范围,这也是行不通的。 有什么build议么?

编辑修正了在错误的部分错字,我仍然得到应用程序定义或对象定义的错误

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 

我认为你有一个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可以帮助find这些。 你可以在这里阅读更多。

请注意,当您在一行中定义多个项目时,只有最后一个variables实际上是使用指定的types定义的。 例如:

 Dim PivotName, Pivotname2, Pivotname3, Pivotname4 As String 

结果是创buildvariablesPivotname4作为String但创buildvariables的variablesPivotNamePivotname2Pivotname3

您将String值分配给PivotNamePivotname2Pivotname3因此如果您在debugging时查看项目types,则会看到它们是Variant/String 。 看起来应该没问题,但这可能是一个问题。

您可以尝试更改您的Dim语句,以将variablestypes显式设置为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 ? 如果它不存在,您可能需要添加它,然后才能应用filter。

我没有看到为“W3”定义的任何内容。 你有“ws3”等,但没有“w3”。 是吗?

编辑:如果您仍然收到错误,可能是“计划月”有问题

谢谢大家的帮助,问题似乎是date值没有被识别为一个对象,因此我必须以另一种方式来做这件事。 我创build了一个循环来检查数据表中与“控制表”中的date相对应的值。 如果它们小于date或等于它,则值将是“包含”,否则将是“不包含”。 filter被设置为“包含”。 下面的代码

 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