VBA创建数据透视表报错但同数据源手动可正常创建咨询

• 核心问题：创建PivotCache时，SourceData参数仅传入了纯单元格地址（如$A$1:$AK$200），未携带所属工作表信息，程序无法正确读取数据源的列标题，因此触发字段名无效报错。手动创建透视表时会自动关联选中区域的工作表路径，所以可以正常生成。
• 其他潜在风险：
  1. 新增「Summary」工作表前未校验同名工作表是否存在，重复运行代码会触发重名错误
  2. 原有清空透视表的逻辑仅清除内容，未删除透视表对象，重复运行会出现同名透视表报错
  3. getTable函数的错误处理分支写死创建Table1，如果传入其他表名会导致赋值失败

直接修改PivotCache创建行的SourceData参数，传入完整的Range对象即可自动识别路径，同时修复其他潜在问题，完整代码如下：

Sub CreatePivot()
    Dim NewSheet As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PTRange As Range
    Dim wb As Workbook
    
    ' 绑定工作簿避免重复调用
    Set wb = Workbooks("東京威力_樞紐分析.xlsm")
    
    ' 先删除已存在的Summary表
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets("Summary").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    ' 新增汇总表
    Set NewSheet = wb.Sheets.Add(Before:=wb.Worksheets(1))
    NewSheet.Name = "Summary"
    
    ' 获取数据源范围
    Set PTRange = getTable("Table1", wb).Range
    
    ' 创建PivotCache，直接传入Range对象即可自动识别路径
    Set PTCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PTRange)
    
    ' 创建透视表
    Set PT = PTCache.CreatePivotTable(TableDestination:=NewSheet.Cells(2, 2), TableName:="PivotTable1")
    
    PT.ManualUpdate = True
    PT.AddFields RowFields:=Array("Recharge BU", "Main Category"), ColumnFields:="Recharge To"
    
    With PT.PivotFields("Hours")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0.00"
        .Name = "Total - Hours"
    End With
    
    PT.ManualUpdate = False
End Sub

Function getTable(tableName As String, wb As Workbook) As ListObject
    Dim FinalRow As Long
    Dim ws As Worksheet
    Set ws = wb.Worksheets("原始資料")
    
    With ws
        On Error GoTo ErrorHandler
        Set getTable = .ListObjects(tableName)
        Exit Function
    End With
     
ErrorHandler:
    Debug.Print Err.Number & ":" & Err.Description
    If getTable Is Nothing Then
        FinalRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ws.ListObjects.Add(xlSrcRange, ws.Range("A1:AK" & FinalRow), , xlYes).Name = tableName
        Set getTable = ws.ListObjects(tableName)
    End If
End Function

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