用VBA查看和删除透视表明细数据

FENGJUN

觉得双击查看明细数据很麻烦，每次都要生成一个新表。解决方案如下，欢迎分享更好的方法：

Sub ShowPivotDetail()
'显示数据透视表明细数据

    Dim PivotRng As Range
    Dim PivotLastcell As Range
    Dim lr As Long
    Dim lc As Long

    On Error GoTo 1
    Set PivotRng = Me.Range("A5").PivotTable.TableRange1
    lr = PivotRng.Rows.Count
    lc = PivotRng.Columns.Count

    Set PivotLastcell = PivotRng.Cells(lr, lc)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With ThisWorkbook
        PivotLastcell.ShowDetail = True
        On Error Resume Next
        .Worksheets("透视表明细数据").Delete
    End With

    With ActiveSheet
        .Name = "透视表明细数据"
        With .Cells.Font
            .Name = "宋体"
            .Size = 9
        End With
        .Cells.EntireColumn.AutoFit
    End With
    MsgBox "操作（生成表）完成!"

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub
1:
    '    MsgBox Err.Description
    MsgBox "操作终止：" & Chr(10) & "未发现数据透视表或数据透视表尚无数值字段!"

End Sub

Private Sub Worksheet_Activate()
'自动删除明细表
'    Application.DisplayAlerts = False
    With ThisWorkbook
        On Error Resume Next
        .Worksheets("透视表明细数据").Delete
        MsgBox "操作（删除表）完成!"
    End With
    '    Application.DisplayAlerts = True
End Sub

ysese

谢谢楼主分享， 学习！

蒋老三

有2003版的吗，我的excel打不开

蒋老三

看到的是全部明细

sundream

这个功能很需要，不知道还也没有其他好的办法

bibisin

谢谢LZ分享

donghan

留个记号，以后学习