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