一键生成数据透视表并设置其格式

ranger丶亦

Sub 创建数据透视表()
   Dim PT As PivotTable, PTCache As PivotCache
   Dim iR As Integer, iC As Integer, strSourceData As String
   Set wsh = Sheets("汇总表")

   iR = wsh.Cells(Rows.Count, 1).End(xlUp).Row - 1
   iC = wsh.Cells(1, Columns.Count).End(xlToLeft).Column - 1
   strSourceData = "汇总表!R1C1:R" & iR & "C" & iC

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   On Error Resume Next

   Set PTCache = ActiveWorkbook.PivotCaches.Create( _
               SourceType:=xlDatabase, _
               SourceData:=strSourceData)
   Sheets("类别汇总").Delete
   Sheets.Add.Name = "类别汇总"
   ActiveWindow.DisplayGridlines = False

   Set PT = ActiveSheet.PivotTables.Add( _
          PivotCache:=PTCache, _
          tabledestination:=Range("a3"), _
          TableName:="类别透视")

   With PT
       .PivotFields("类别").Orientation = xlRowField
       .PivotFields("公司").Orientation = xlRowField
   End With

    With PT.PivotFields("总销量")
          .Orientation = xlDataField
          .Function = xlSum
   End With

    With PT.PivotFields("伟星总销量")
          .Orientation = xlDataField
          .Function = xlSum
   End With

    With PT.PivotFields("销量统计")
          .Orientation = xlDataField
          .Function = xlSum
   End With

   With PT.PivotFields("PPR")
          .Orientation = xlDataField
          .Function = xlSum
   End With

   With PT.PivotFields("PPR桔")
          .Orientation = xlDataField
          .Function = xlSum
   End With

'    With PT.PivotFields("PPR灰")
'          .Orientation = xlDataField
'          .Function = xlSum
'   End With
'
'    With PT.PivotFields("F-PPR")
'          .Orientation = xlDataField
'          .Function = xlSum
'   End With
'
'
'    With PT.PivotFields("SPM")
'          .Orientation = xlDataField
'          .Function = xlSum
'   End With
'
'    With PT.PivotFields("纳米")
'          .Orientation = xlDataField
'          .Function = xlSum
'   End With
'
'   With PT.PivotFields("PPR")
'          .Orientation = xlDataField
'          .Function = xlSum
'   End With
   ActiveSheet.PivotTables("类别透视").CompactLayoutRowHeader = "类别"
   With ActiveSheet.PivotTables("类别透视")
        With .PivotFields("类别")
             .LayoutForm = xlTabular
             .Subtotals = Array(False, False, False, False, False, False, _
                              False, False, False, False, False, False)
        End With
        With .PivotFields("公司")
             .LayoutForm = xlTabular
             .Subtotals = Array(False, False, False, False, False, False, _
                              False, False, False, False, False, False)
        End With
   End With
End Sub

Sub 汇总数据()
   With ActiveSheet.PivotTables("类别透视").PivotFields("类别")
       .PivotItems("包工包料").ShowDetail = False
       .PivotItems("零售").ShowDetail = False
       .PivotItems("其它").ShowDetail = False
       .PivotItems("私单").ShowDetail = False
       .PivotItems("装饰公司").ShowDetail = False
   End With
End Sub

Sub 明细数据()
   With ActiveSheet.PivotTables("类别透视").PivotFields("类别")
       .PivotItems("包工包料").ShowDetail = True
       .PivotItems("零售").ShowDetail = True
       .PivotItems("其它").ShowDetail = True
       .PivotItems("私单").ShowDetail = True
       .PivotItems("装饰公司").ShowDetail = True
   End With
End Sub

Sub 修改字段名()
   With ActiveSheet.PivotTables("类别透视")
      .PivotFields("求和项:伟星总销量").Caption = "伟星销量"
      .PivotFields("求和项:销量统计").Caption = "工资销量"
      .PivotFields("求和项:PPR").Caption = "PPR "
      .PivotFields("求和项:PPR桔") = "PPR桔 "
   End With
End Sub

Sub 设置数据透视表格式()
    Set wsh = Sheets("类别汇总")
    With ActiveSheet.PivotTables("类别透视")
        .TableStyle2 = "PivotStyleMedium14" '设置 设计显示数据透视表的格式,其中共有浅色、中等色、深色三大系列
        .MergeLabels = True '设置 合并且居中排列带标签的单元格
    End With

    Range("a4").CurrentRegion.Select
    With Selection.Font
       .Name = "宋体"
       .Size = 11
       .ThemeColor = xlThemeColorLight1
    End With

   With Selection
       .NumberFormatLocal = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
       .Columns.EntireColumn.AutoFit
       With .Borders
            .LineStyle = xlContinuous
            .Weight = xlHairline
       End With
   End With
End Sub

Sub 设置标题()
   Dim iRow As Integer, iCol As Integer
   Set wsh = Sheets("类别汇总")
   iRow = wsh.Cells(Rows.Count, 1).End(xlUp).Row
   iCol = wsh.Cells(4, Columns.Count).End(xlToLeft).Column
   wsh.Range(wsh.Cells(1, 1), wsh.Cells(2, iCol)).Merge
   Set wks = Sheets("导出数据")
   wsh.Range("A1") = Month(wks.Range("b2").Value) & "月数据汇总"
   With wsh.Range("a1").Font
       .Name = "方正正大黑简体"
       .Size = 20
   End With
End Sub

deadzlq

（非通用）代码离开了数据没有任何意义，录制宏的都比这有用