Pivot Drilldown Macro遇非连续数值报Run-Time error '1004'如何解决

报错的核心原因是可见的PivotItem在当前透视表筛选状态下无对应数据条目，DataRange属性不存在，直接调用就会触发1004运行时错误。
只需在原有代码逻辑中增加临时错误捕获，无有效数据的项自动跳过即可，同时保留自定义工作表命名逻辑，修改后的代码如下：

Dim pField As PivotField
Dim pItem As PivotItem
' 指定要操作的透视表字段
Set pField = Sheets("Pivot Table").PivotTables(1).PivotFields("HFB")

Application.ScreenUpdating = False

' 遍历字段下所有项
For Each pItem In pField.PivotItems
    If pItem.Visible Then
        ' 临时开启错误忽略，校验DataRange是否存在
        On Error Resume Next
        Dim testRange As Range
        Set testRange = pItem.DataRange
        ' 错误码不为0说明无有效DataRange，直接跳过当前项
        If Err.Number = 0 Then
            pItem.DataRange.ShowDetail = True
            ' 重命名前校验名称合法性、避免重名冲突
            If Len(Right(pItem.Name, 4)) > 0 And Not SheetExists(Right(pItem.Name, 4)) Then
                ActiveSheet.Name = Right(pItem.Name, 4)
            End If
        End If
        ' 恢复默认错误捕获，避免其他异常被静默忽略
        On Error GoTo 0
        Set testRange = Nothing
    End If
Next pItem

Application.ScreenUpdating = True

' 辅助函数：判断工作表是否已存在
Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not ws Is Nothing
End Function

优化说明 #

• 新增DataRange有效性校验逻辑，无数据的项直接跳过，彻底解决1004报错问题
• 新增工作表重名、非法名称校验，避免重命名环节触发额外错误
• 完全保留原有自定义工作表命名规则，不会生成默认的Sheet 1类名称

内容的提问来源于stack exchange，提问作者Paul Flood