求助：VBA代码生成普通透视表而非数据模型透视表的解决方案

你的代码生成普通透视表的核心原因是使用了xlDatabase类型的PivotCache，这是普通透视表的数据源类型，而非数据模型透视表所需的外部连接类型。以下是两种可行的修正方案：

方案一：直接基于数据模型创建透视表 #

先将数据源添加到工作簿的数据模型，再创建关联数据模型的PivotCache和透视表：

Sub CreateTwoDataModelPivotTablesInSameSheet()
    Dim wsSummary As Worksheet, wsProcessedData As Worksheet
    Set wsSummary = ThisWorkbook.Sheets("Summary")
    Set wsProcessedData = ThisWorkbook.Sheets("Processed Data")
    
    ' 清除现有透视表
    On Error Resume Next
    wsSummary.PivotTables.ClearAll
    On Error GoTo 0
    
    ' 初始化数据模型（确保工作簿启用数据模型）
    ThisWorkbook.Model.Initialize
    
    ' 将数据源添加到数据模型（如果尚未添加）
    Dim lo As ListObject
    On Error Resume Next
    Set lo = wsProcessedData.ListObjects("ProcessedDataList")
    On Error GoTo 0
    If lo Is Nothing Then
        Set lo = wsProcessedData.ListObjects.Add(xlSrcRange, wsProcessedData.UsedRange, , xlYes)
        lo.Name = "ProcessedDataList"
        lo.AddToDataModel ' 关键：将表添加到数据模型
    End If
    
    ' 创建基于数据模型的PivotCache
    Dim pc As PivotCache
    Set pc = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlExternal, _
        SourceData:=ThisWorkbook.Model.DataModelConnection)
    
    ' 计算第二个透视表的起始行
    Dim lastRow As Long
    lastRow = wsSummary.Cells(wsSummary.Rows.Count, 2).End(xlUp).Row + 10
    
    ' 创建第一个数据模型透视表
    Dim pt1 As PivotTable
    Set pt1 = pc.CreatePivotTable( _
        TableDestination:=wsSummary.Cells(60, 2), _
        TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion15) ' 指定支持数据模型的Excel版本（2013+）
    
    ' 配置第一个透视表字段
    With pt1.PivotFields("Preparer")
        .Orientation = xlPageField
    End With
    With pt1.PivotFields("Reviewer")
        .Orientation = xlPageField
    End With
    With pt1.PivotFields("Year & Month")
        .Orientation = xlPageField
    End With
    With pt1.PivotFields("Error Rate")
        .Orientation = xlPageField
    End With
    With pt1.PivotFields("Major Error")
        .Orientation = xlRowField
    End With
    ' 数据模型支持的去重计数字段
    Dim df1 As PivotField
    Set df1 = pt1.AddDataField(pt1.PivotFields("Check Number"), "%", xlDistinctCount)
    df1.Calculation = xlPercentOfColumn
    df1.NumberFormat = "0%"
    ' 普通计数字段
    Dim df2 As PivotField
    Set df2 = pt1.AddDataField(pt1.PivotFields("Check Number"), "% of Check Number", xlCount)
    df2.Calculation = xlPercentOfColumn
    df2.NumberFormat = "0%"
    
    pt1.TableStyle2 = "PivotStyleDark10"
    pt1.RefreshTable
    
    ' 创建第二个数据模型透视表（复用同一个缓存，节省资源）
    Dim pt2 As PivotTable
    Set pt2 = pc.CreatePivotTable( _
        TableDestination:=wsSummary.Cells(lastRow, 6), _
        TableName:="PivotTable2", _
        DefaultVersion:=xlPivotTableVersion15)
    
    ' 配置第二个透视表字段
    With pt2.PivotFields("Preparer")
        .Orientation = xlPageField
    End With
    Dim df3 As PivotField
    Set df3 = pt2.AddDataField(pt2.PivotFields("Check Number"), "% of Check Number", xlCount)
    df3.Calculation = xlPercentOfColumn
    df3.NumberFormat = "0%"
    
    pt2.TableStyle2 = "PivotStyleLight16"
    pt2.RefreshTable
    
    ' 设置列宽
    wsSummary.Range("B:C").EntireColumn.ColumnWidth = 20
    wsSummary.Range("F:G").EntireColumn.ColumnWidth = 20
End Sub

关键修正点说明 #

• 数据源入模：通过ListObject.AddToDataModel将数据区域转为表格并加入数据模型，这是数据模型透视表的基础前提。
• 缓存类型切换：使用xlExternal作为SourceType，关联工作簿内置的数据模型连接，确保缓存基于数据模型而非普通单元格区域。
• 版本指定：DefaultVersion:=xlPivotTableVersion15对应Excel 2013及以上版本，是启用数据模型功能的必要参数。
• 缓存复用：两个透视表共用同一个数据模型缓存，减少内存占用并提升刷新效率。

方案二：手动创建数据模型连接（替代方案） #

如果不想通过ListObject，可直接创建数据模型连接并生成透视表，核心是确保PivotCache指向数据模型：

' 替换原代码中PivotCache创建部分的核心片段
Dim conn As WorkbookConnection
On Error Resume Next
Set conn = ThisWorkbook.Connections("WorkbookDataModel")
On Error GoTo 0
If conn Is Nothing Then
    Set conn = ThisWorkbook.Connections.Add2( _
        Name:="WorkbookDataModel", _
        Description:="Connection to Workbook Data Model", _
        ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=ProcessedDataList;Extended Properties=""""", _
        CommandText:="SELECT * FROM [ProcessedDataList]", _
        lCmdtype:=xlCmdSql)
End If

Set pc = ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlExternal, _
    SourceData:=conn)

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