vba的透视表制作

Sub acknowledge()
'
' acknowledge Macro
' 宏由 Administrator 录制，时间: 2020/08/07
'

'
    Range("A1:B7").Select
    Range("B7").Activate
    Rows("1:7").Delete Shift:=xlShiftUp
    Columns("C:E").Select
    Range("E1").Activate
    Selection.Copy

    Filename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
    Filename = Sheets(1).Name
    Sheets.Add After:=Sheets(Filename), Count:=1
    ActiveSheet.Paste
    Sheets(Filename).Activate
    Columns("J:J").Select
    Selection.Copy
    Sheets(2).Activate
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("A:D").Select
    Range("D1").Activate
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 1
     

    '创建透视表'
    Dim CA As PivotCache
    Dim TA As PivotTable
    Set CA = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    Sheets(2).Range("a1").CurrentRegion, _
    Version:=xlPivotTableVersion10)
    Set TA = CA.CreatePivotTable(TableDestination:=Range("f1"), TableName:="abc")
  

    Sheets(2).Activate
    '添加行'
    ActiveSheet.PivotTables("abc").AddFields RowFields:=Array("小时")

    '设置数值'
    With ActiveSheet.PivotTables("abc")
        .AddDataField .PivotFields("展现"), "展现", xlSum
        .AddDataField .PivotFields("点击"), "点击", xlAverage
        .AddDataField .PivotFields("消费"), "消费", xlSum
        .RowAxisLayout xlTabularRow                                     '以表格格式显示布局'
        '.PivotFields("组别").CurrentPage = "包装组"'
    End With
  
End Sub