VBA数据透视表数据源设置求助：指定Monthly工作表B列作为数据源

要将数据透视表的数据源指定为"Monthly"工作表的B列，只需修改代码中定义数据源范围（DR）的部分，同时调整获取最后一行的逻辑（原代码按A列取，现在要按B列取）。

关键修改点： #

• 获取B列最后一行行号：把原代码中按A列（第1列）获取最后一行的逻辑，改为按B列（第2列）获取。
• 定义B列数据源范围：直接指定范围为B列从第1行到最后一行的单元格区域。

修改后的完整代码： #

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PvtCache As PivotCache
Dim PvtTable As PivotTable
Dim DR As Range
Dim LR As Long
Dim sht5 As Variant

On Error GoTo errhandler

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

For Each sht5 In ActiveWorkbook.Worksheets
    If sht5.Name = "Pivot" Then
        sht5.Delete
    End If
Next sht5

On Error GoTo 0
Worksheets.Add.Name = "Pivot"

Set DSheet = Worksheets("Monthly")
Set PSheet = Worksheets("Pivot")

' 按B列获取最后一行行号
LR = DSheet.Cells(Rows.Count, 2).End(xlUp).Row
' 定义数据源为B列第1行到最后一行
Set DR = DSheet.Cells(1, 2).Resize(LR, 1)

Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DR)
Set PvtTable = PvtCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="Monthly")

With PvtTable.PivotFields("Chutes") ' 注意：此处字段名需与B1单元格内容一致
    .Orientation = xlRowField
    .Position = 1
End With

With PvtTable.PivotFields("Chutes")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlCount
End With

errhandler:
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

额外说明： #

• 代码末尾补充了错误处理收尾逻辑，恢复Excel的显示提示和屏幕更新，避免后续操作异常。
• 如果B列表头不是"Chutes"，需要将代码中PivotFields("Chutes")的字段名改为B1单元格的实际内容，否则会触发报错。

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