VBA创建Excel数据透视表时如何动态获取可变SourceData范围

核心修改逻辑是动态计算Sheet1的实际有效数据范围，替换硬编码的Sheet1!R1C1:R193C9即可适配数据源行数变动场景，其余透视表、图表配置逻辑无需改动。

修改逻辑说明 #

• 由于你的数据源固定为9列（A列到I列），仅需要在创建透视表缓存前，动态获取数据源最后一行的行号，拼接成符合R1C1格式的范围字符串即可。
• 额外补充了两处容错优化：一是重复运行宏时自动删除已存在的Result工作表，避免重名报错；二是同步将图表数据源改为动态匹配透视表行数，避免行数变动后图表显示不全。

可直接运行的完整代码 #

Sub GenerateSignoffPivot()
    Dim wsSource As Worksheet
    Dim lastDataRow As Long
    Dim dynamicSource As String
    
    ' 绑定数据源工作表
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 从A列底部向上定位最后一个非空行，适配行数动态变化
    lastDataRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    ' 拼接R1C1格式的动态数据源范围
    dynamicSource = "Sheet1!R1C1:R" & lastDataRow & "C9"
    
    wsSource.Activate
    ' 容错处理：删除已存在的Result表避免重名报错
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Result").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' 新建结果工作表
    Sheets.Add(After:=Sheets("Sheet1")).Name = "Result"

    Windows("User_Signoff_Duration_Report (version 1).xlsb").Activate
    ' 替换原硬编码范围为动态拼接的数据源
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        dynamicSource, Version:=7).CreatePivotTable TableDestination:= _
        "Result!R3C1", TableName:="PivotTable2", DefaultVersion:=7
    
    Sheets("Result").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
    
    ' 配置透视表字段
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Reviewer Job Function")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Status")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Signoff Duration"), "Sum of Signoff Duration", _
        xlSum
    With ActiveSheet.PivotTables("PivotTable2").PivotFields( _
        "Sum of Signoff Duration")
        .Caption = "Average of Signoff Duration"
        .Function = xlAverage
        .NumberFormat = "0.00"
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Status").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Status").CurrentPage = "CCB"
    
    ' 生成柱状图，动态匹配透视表数据范围
    Dim ptLastRow As Long
    ptLastRow = Sheets("Result").Cells(Sheets("Result").Rows.Count, "A").End(xlUp).Row
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("Result!$A$3:$B$" & ptLastRow)
    With ActiveSheet.Shapes("Chart 1")
        .IncrementLeft 63.5
        .IncrementTop -77
        .ScaleWidth 1.3020833333, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.1643518519, msoFalse, msoScaleFromTopLeft
    End With
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    
    ActiveCell.Offset(0, 11).Range("A1").Select
    Windows("NewMacros.xlsm").Activate
End Sub

注意事项 #

如果你的数据源第一列（A列）存在空值，会导致取到的最后一行行号偏小，此时可将取lastDataRow代码中的列号"A"改为数据源中无空值的列（比如Signoff Duration对应的列号）即可。

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