Excel VBA创建年度数据透视表时出现Runtime Error 1004问题

Runtime Error 1004的核心原因是数据源引用格式不一致：处理2018年时，SrcData可能是Daten!A1:Bxxx这类仅包含工作表和范围的引用；但处理2019年时，新建工作表后当前激活对象变化，导致Excel自动给SrcData加上了工作簿文件名（比如[文件名.xlsx]Daten!A1:Bxxx），格式混乱引发解析错误。

要彻底解决问题，需强制统一数据源的引用格式，确保每次创建透视表时都使用包含工作簿、工作表和明确数据范围的标准绝对引用。以下是两种可靠修复方式：

方式1：手动构建标准绝对引用 #

直接拼接包含工作簿名、工作表名和数据范围的字符串，避免Excel自动生成不一致格式：

' 定义原始数据工作表和数据范围
Dim wsDaten As Worksheet
Set wsDaten = ThisWorkbook.Worksheets("Daten")
Dim dataRange As Range
Set dataRange = wsDaten.Range("A1:B" & wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row)

' 构建符合透视表要求的标准数据源字符串
Dim srcDataStr As String
srcDataStr = "'[" & ThisWorkbook.Name & "]" & wsDaten.Name & "'!" & dataRange.Address(ReferenceStyle:=xlR1C1)

后续创建透视表时，直接使用srcDataStr作为SourceData参数。

方式2：将原始数据转为结构化表（ListObject） #

把"Daten"工作表的订单数据转为Excel结构化表，数据源引用会更稳定，不受激活状态影响：

1. 选中"Daten"工作表A1:B数据区域（包含表头），按Ctrl+T创建结构化表，勾选"我的表有标题"
2. 修改VBA代码，直接引用结构化表作为数据源：

Dim tblOrders As ListObject
Set tblOrders = ThisWorkbook.Worksheets("Daten").ListObjects(1) ' 假设是第一个结构化表

' 创建透视表时直接传入结构化表对象
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tblOrders). _
    CreatePivotTable TableDestination:=newWs.Range("A3"), TableName:="PivotTable_" & yearVal

这种方式的额外优势是数据范围会自动扩展，后续新增订单无需调整代码。

Sub CreateYearlyPivots()
    Dim wsDaten As Worksheet
    Set wsDaten = ThisWorkbook.Worksheets("Daten")
    
    Dim uniqueYears As Collection
    Set uniqueYears = New Collection
    
    ' 提取2018-2024的唯一年份
    On Error Resume Next
    For Each cell In wsDaten.Range("A2:A" & wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row)
        If cell.Value >= 2018 And cell.Value <= 2024 Then
            uniqueYears.Add cell.Value, Key:=CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 预定义统一数据源字符串
    Dim dataRange As Range
    Set dataRange = wsDaten.Range("A1:B" & wsDaten.Cells(wsDaten.Rows.Count, "A").End(xlUp).Row)
    Dim srcDataStr As String
    srcDataStr = "'[" & ThisWorkbook.Name & "]" & wsDaten.Name & "'!" & dataRange.Address(ReferenceStyle:=xlR1C1)
    
    ' 遍历年份创建工作表和透视表
    Dim yearVal As Variant
    Dim newWs As Worksheet
    For Each yearVal In uniqueYears
        ' 检查工作表是否存在，不存在则新建
        On Error Resume Next
        Set newWs = ThisWorkbook.Worksheets(CStr(yearVal))
        On Error GoTo 0
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = CStr(yearVal)
        End If
        
        ' 清除现有透视表（避免重复创建报错）
        Dim pt As PivotTable
        For Each pt In newWs.PivotTables
            pt.TableRange2.Clear
        Next pt
        
        ' 创建透视表缓存和透视表
        Dim ptCache As PivotCache
        Set ptCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcDataStr)
        
        Dim ptNew As PivotTable
        Set ptNew = ptCache.CreatePivotTable(TableDestination:=newWs.Range("A3"), TableName:="PivotTable_" & yearVal)
        
        ' 设置透视表字段和筛选
        With ptNew
            .PivotFields("客户").Orientation = xlRowField
            .AddDataField .PivotFields("年份"), "订单数", xlCount
            .PivotFields("年份").Orientation = xlPageField
            .PivotFields("年份").CurrentPage = yearVal
        End With
        
        Set newWs = Nothing
    Next yearVal
    
    MsgBox "所有年份透视表生成完成！"
End Sub

• 避免依赖ActiveSheet或ActiveWorkbook引用数据源，始终明确指定工作簿和工作表对象
• 使用xlR1C1格式地址，确保透视表数据源在不同环境下都能被正确解析
• 处理重复工作表的情况，避免因工作表已存在引发报错

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