VBA如何基于当前选中区域而非固定范围创建PivotTable

核心修改思路 #

PivotCaches.Create的SourceData参数支持接收带工作表标识的R1C1格式区域地址，只需要把当前选中的单元格区域按规则拼接成合法地址，替换原来的硬编码固定值即可，不需要绑定死范围。
实现时需要注意两个兼容细节：

• 先判断当前选中的对象是否为单元格区域，避免选中图形、控件等对象时触发运行错误
• 拼接地址时给工作表名加单引号包裹，兼容名称带空格、特殊字符的工作表

修改后完整代码 #

Sub CreatePivotFromSelection()
    Dim pvSourceRng As Range
    Dim pvSourceAddr As String
    
    ' 校验选中对象合法性
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中要作为数据源的单元格区域再运行代码", vbExclamation
        Exit Sub
    End If
    Set pvSourceRng = Selection
    
    ' 拼接透视表缓存要求的标准数据源地址
    pvSourceAddr = "'" & pvSourceRng.Parent.Name & "'!" & pvSourceRng.Address(ReferenceStyle:=xlR1C1)
    
    ' 创建透视表，替换原硬编码的数据源参数
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        pvSourceAddr, Version:=7).CreatePivotTable TableDestination:= _
        "Pivot!R2C2", TableName:="PivotTable1", DefaultVersion:=7
    Sheets("Pivot").Select
End Sub

补充说明 #

• 如果需要保留自动识别连续数据块的逻辑（不需要手动提前选区域），可以把Set pvSourceRng = Selection替换为自动识别区域的代码，注意原录制代码里写死了从N1开始选，会丢失N列左侧的数据，正确的连续区域识别写法如下：

' 自动识别当前表从A1单元格开始的整块连续数据
With ActiveSheet ' 如果要指定工作表就改成 Sheets("Updated data")
    Set pvSourceRng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown).End(xlToRight))
End With

• 如果Pivot工作表中已经存在名为PivotTable1的透视表，运行会触发重名报错，提前删除旧透视表或者修改新透视表的TableName参数即可。

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