VBA - GetPivotData - 无法捕获 运行-时间错误 1004

VBA - GetPivotData - Can't trap Run-time error 1004

我正在研究 select Pivot Table 的一部分并发送该摘录的过程。

一切正常,除了我一直有一个 运行-time error 1004 我无法捕获( 避免它和继续循环) 所以我的循环不流畅...

这里是有问题的部分:

    On Error GoTo 0
    On Error GoTo NextSale
    If IsError(pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)) Then GoTo NextSale
    Set Rg = pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)
    On Error GoTo 0

    Set RgT = Union(RgT, Rg)
NextSale:

因为pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)会抛出一个运行-time error 1004,当组合在数据中不存在而我只想避免在循环中被阻止。

我进行了搜索,但未能解决此问题...IsError()On Error GoTo 均无效。我什至检查了选项 (Tools->Options->General->Error Trapping) 我已经在 Break on Unhandled Errors...

完整代码如下:

Sub testPt()
Dim Pt As PivotTable, _
    Pf As PivotField, _
    Pi As PivotItem, _
    PiO As PivotItem, _
    Ws As Worksheet, _
    TpStr As String, _
    RgT As Range, _
    Rg As Range

Set Ws = ThisWorkbook.Sheets("PT_All")

For Each Pt In Ws.PivotTables
    For Each Pf In Pt.PivotFields
        If Pf.Name <> "Sales" Then
        Else
            For Each Pi In Pf.PivotItems
                Set RgT = Pi.LabelRange
                For Each PiO In Pt.PivotFields("Sales_Opp").PivotItems

                    On Error GoTo 0
                    On Error GoTo NextSale
                    If IsError(Pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)) Then GoTo NextSale
                    Set Rg = Pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)
                    On Error GoTo 0

                    Set RgT = Union(RgT, Rg)
NextSale:
                Next PiO
                RgT.Select
                MsgBox RgT.Address
            Next Pi
        End If
    Next Pf
Next Pt

End Sub

问题可能与范围错误处理(或缺少范围错误处理)有关。

以下代码未经测试,但您应该能够找出其中的错误并根据您的要求进行调整...

Sub testPt()
    Dim Pt As PivotTable, _
        Pf As PivotField, _
        Pi As PivotItem, _
        PiO As PivotItem, _
        TpStr As String, _
        RgT As Range, _
        Rg As Range

    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("PT_All")

    For Each Pt In ws.PivotTables
        For Each Pf In Pt.PivotFields
            If Pf.Name = "Sales" Then
                For Each Pi In Pf.PivotItems
                    Set RgT = Pi.LabelRange
                    For Each PiO In Pt.PivotFields("Sales_Opp").PivotItems
                        Set Rg = Nothing
                        On Error Resume Next
                        Set Rg = Pt.GetPivotData("Amount", Pf.Name, Pi.Name, "Sales_Opp", PiO.Name)
                        On Error GoTo 0
                        If Not RgT Is Nothing Then
                            If Not Rg Is Nothing Then Set RgT = Union(RgT, Rg)
                        Else: If Not Rg Is Nothing Then Set RgT = Rg
                        End If
                    Next PiO
                Next Pi
            End If
        Next Pf
    Next Pt

    If Not RgT Is Nothing Then
        RgT.Select
        MsgBox RgT.Address
    Else: MsgBox "RgT is empty"
    End If

End Sub

我感觉它是第二次失败,而不是第一次。
它已经成功捕获了第一个错误,但是由于没有 Resume xxxxxx 语句,所以当它遇到下一个错误时它仍在尝试进行错误处理。不允许嵌套错误处理,所以会出错。

删除 On Error Goto 0 行,并将剩余的 On Error 更改为

On Error GoTo Err_Handlr

然后,就在 End Sub 之前,添加以下内容:

Unexpected_Err:
Exit Sub

Err_Handlr:
If err.number=1004
    Resume NextSale
Else
    Msgbox "Can't handle " & err.description
    Resume Unexpected_Err
end if

请注意,我正在寻找预期的错误编号 - 这意味着如果其他部分损坏,我至少可以得到通知,而不是因为任何其他可能发生的副作用而失去控制