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

时间：2014-10-27 04:53:18

标签： excel vba excel-vba

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

代码一直有效，直到它到达需要应用过滤器的部分。我有一个日期值，我在一个名为PivotFilter的String下声明，当代码去应用过滤器时，我得到一个运行时错误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

3 个答案:

答案 0 :(得分：2)

我认为您在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尚未定义。

使用Dim PivotName, Pivotname2, Pivotname3, Pivotname4 As String 可以帮助您找到这些内容。您可以阅读更多相关信息here。

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

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 。例如：

PivotField

还有一件事：{{1}}命名为＆＃34;计划月＆＃34;数据透视表中存在哪些内容？如果它不存在，您可能需要添加它才能应用过滤器。

答案 1 :(得分：0)

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

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

答案 2 :(得分：0)

感谢大家的帮助，问题似乎是日期值没有被识别为对象，因此我不得不采取另一种方式。我创建了一个循环来检查数据表中的值与“控制表”中的日期。如果它们小于日期或等于它，那么该值将是“包含”，否则它将“不包括”。然后将过滤器设置为＆＃39; Include＆＃39;。代码

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
相关问题
最新问题