VBA 使用“数据添加到数据模型”来创建数据透视表

Question

我下面有以下代码。 数据透视表创建得很好，但没有选择“数据添加到数据模型”选项。这意味着我无法在值字段中使用“不同计数”选项。 我如何实现这一目标？

Sub test()

testpath = "C:\UserData\testfolder\testfile.xlsx"

With Workbooks.Open(testpath)
    Dim ws As Worksheet
    Set ws = .Worksheets(2)
    ws.Activate
    Dim newSheet As Worksheet
    Set newSheet = .Worksheets.Add(Before:=ws)
    newSheet.Name = "PivotTableSheet"
    Dim pivotCache As pivotCache
    Set pivotCache = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.UsedRange, Version:=xlPivotTableVersion15)
    Dim pivotTable As pivotTable
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=newSheet.Cells(1, 1), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15)
End With

End Sub

Answer 1

您需要将范围添加到连接中。

Option Explicit

Sub Test()

    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim NewSheet As Worksheet
    Dim PivotCache As PivotCache
    Dim PivotTable As PivotTable
    Dim Conn As WorkbookConnection
    Dim Rng As Range
    Dim ConnName As String
    Dim TestPath As String
    TestPath = "C:\UserData\testfolder\testfile.xlsx"
    Rem TestPath = "D:\vba\sample data\SampleData.xlsx"
    Rem Open the workbook
    Set Wb = Workbooks.Open(TestPath)
    Set Ws = Wb.Worksheets(2)
    
    Rem Define the data range, assuming the data has headers
    Set Rng = Ws.UsedRange
    
    Rem Create a new sheet for the PivotTable
    Set NewSheet = Wb.Worksheets.Add(Before:=Ws)
    NewSheet.Name = "PivotTableSheet"
    
    Rem Add the UsedRange to the Data Model by creating a WorkbookConnection
    ConnName = "DataModelConnection"
    On Error Resume Next ' Ignore if connection already exists
    Set Conn = Wb.Connections(ConnName)
    On Error GoTo 0
    
    If Conn Is Nothing Then
        Set Conn = Wb.Connections.Add2(Name:=ConnName, _
                                       Description:="Connection to worksheet data", _
                                       ConnectionString:="WORKSHEET;" & Wb.FullName, _
                                       CommandText:=Rng.Address(External:=True), _
                                       lCmdtype:=xlCmdExcel)
    End If
    
    Rem Now create a PivotCache from the Data Model (external connection)
    Set PivotCache = Wb.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn, Version:=xlPivotTableVersion15)
    
    Rem Create the PivotTable from the data model connection
    Set PivotTable = PivotCache.CreatePivotTable( _
        TableDestination:=NewSheet.Cells(1, 1), _
        TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion15)
    
    Rem Cleanup
    Set Wb = Nothing
    Set Ws = Nothing
    Set Rng = Nothing
    Set NewSheet = Nothing
    Set PivotCache = Nothing
    Set PivotTable = Nothing
    
End Sub

您也可以手动添加范围。

1. 选择数据范围

   • 突出显示要添加的数据范围，包括标题。

2. 转到数据选项卡

   • 单击 Excel 功能区中的“数据”选项卡。

3. 单击“来自表/范围”

   • 在“获取和转换数据”组中，单击来自表/范围。

4. 确认范围

   • 在创建表对话框中，确认您的范围正确并检查 “我的表格有标题”框（如果适用）。

5. 加载到数据模型

   • Power Query 编辑器将打开。不进行更改，单击“关闭并加载” 从左上角，然后选择关闭并加载到...
   • 在导入数据对话框中，选择“仅创建连接”并选中标记为 “将此数据添加到数据模型中。”

6. 点击确定

   • 该范围现已添加到数据模型中，以便在数据透视表或 Power Pivot 中使用。