我上周有这个工作。这将使用用户输入的值更新数据透视表搜索,然后根据该条目筛选数据透视表。这是在上周工作,当我更新文件(完全相同的布局)时,我开始收到错误1004.我没有更改任何VBA,所以很困惑为什么它不更新Field.CurrentPage值。任何帮助将不胜感激。
Public OldPull As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'P4 is touched
If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim FValue As PivotItems
Dim NewPull As String
'Here you amend to suit your data
Set pt = Worksheets("Pull Code Search").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Pull Code")
Set FValue = Field.PivotItems
Err.Clear
If IsEmpty(Range("B4").Value) = True Then
NewPull = "(All)"
Else
NewPull = Worksheets("Pull Code Search").Range("B4").Value
End If
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
On Error GoTo ErrMsg
Field.CurrentPage = NewPull
If NewPull = "(All)" And _
OldPull <> NewPull Then
ActiveSheet.PivotTables(1).PivotFields(1).ShowDetail = False
End If
If OldPull <> NewPull Then
pt.RefreshTable
End If
OldPull = NewPull
End With
'This is the error hangling section
ErrMsg:
If Err.Number = 1004 Then
msg = "Pull Code Was not Found" & Chr(13) _
& "You have entered an invalid or partial Pull Code" & Chr(13) _
& "Please try again" & Chr(13) _
& "You searched for: " & NewPull
MsgBox msg, , "Pull Code Not Found", Err.HelpFile, Err.HelpContext
NewPull = "(All)"
End If
Resume Next
End Sub