在 Pivot 中创建动态范围 Table

Creating Dynamic Range in Pivot Table

我正在尝试将我的固定范围 (A1:G4193) 更改为动态范围,因为需要每天输入新数据。

这是我的代码:

Sub Create_Pivot()

Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Dim pf As PivotField

SrcData = ActiveSheet.Name & "!" & Range("A1:G4193").Address(ReferenceStyle:=xlR1C1)

Set sht = Sheets.Add

StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)

Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

Set pvt = pvtCache.CreatePivotTable( _
    TableDestination:=StartPvt, _
    TableName:="PivotTable1")

非常感谢任何帮助。谢谢!

将范围更改为变量 - 例如 RNG 计算范围,你打算怎么做。最后一行、最后一列、最后一个单元格地址等 然后把代码写成这样

    Lastrow = ActiveSheet..Range("B" & Worksheets("All_Data").Rows.Count).End(xlUp).Row
    RNG = "A1:"G" & Lastrow
    SrcData = ActiveSheet.Name & "!" & Range(RNG).Address(ReferenceStyle:=xlR1C1)

假设 - 你的 Pivot Table 的动态范围随着添加(或分散)的行数而变化,而列数保持不变。

不要使用 ActiveSheet,而是尝试使用引用对象,例如 Set SrcSht = Worksheets("Sheet1"),然后使用该变量。

尝试下面的代码(我的一些其他修改在代码注释中)。

Option Explicit

Sub Create_Pivot_DynamicRange()

Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As Range
Dim SrcData As String
Dim pf As PivotField

Dim SrcSht As Worksheet, LastRow As Long

' modify "Sheet1" to your sheet's name
Set SrcSht = Worksheets("Sheet1")

With SrcSht
    ' find last row with data in Column A (skip blank cells in the middle)
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ' set source data to dynamic number of rows (string)
    SrcData = .Name & "!" & .Range("A1:G" & LastRow).Address(ReferenceStyle:=xlR1C1)
End With

Set sht = Sheets.Add

' set the start position directly to a Range (there's no need to use a String as a "middle-man")
Set StartPvt = sht.Range("A1")

Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

Set pvt = pvtCache.CreatePivotTable( _
    TableDestination:=StartPvt, _
    TableName:="PivotTable1")

End Sub