How to create pivot table using vba

后端 未结 2 1993
无人及你
无人及你 2020-12-29 16:26

I am newbie in vba and am trying to create a PivotTable using VBA with excel.

I would like to creat like as below image as input sheet.

2条回答
  •  一个人的身影
    2020-12-29 16:42

    This needs some tidying up but should get you started.

    Note the use of Option Explicit so variables have to be declared.

    Columns names are as per your supplied workbook.

    Option Explicit
    
    Sub test()
    
         Dim PSheet As Worksheet
         Dim DSheet As Worksheet
         Dim LastRow As Long
         Dim LastCol As Long
         Dim PRange As Range
         Dim PCache As PivotCache
         Dim PTable As PivotTable
    
         Sheets.Add
         ActiveSheet.Name = "Pivottable"
    
        Set PSheet = Worksheets("Pivottable")
        Set DSheet = Worksheets("Sheet1")
    
        LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
        LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
        Set PRange = DSheet.Range("A1").CurrentRegion
    
        Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
    
        Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")
    
        With PTable.PivotFields("Region")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With PTable.PivotFields("Channel")
            .Orientation = xlRowField
            .Position = 2
        End With
    
        With PTable.PivotFields("AW code")
            .Orientation = xlRowField
            .Position = 3
        End With
    
        PTable.AddDataField PSheet.PivotTables _
            ("PRIMEPivotTable").PivotFields("Bk"), "Sum of Bk", xlSum
        PTable.AddDataField PSheet.PivotTables _
            ("PRIMEPivotTable").PivotFields("DY"), "Sum of DY", xlSum
        PTable.AddDataField PSheet.PivotTables _
            ("PRIMEPivotTable").PivotFields("TOTal"), "Sum of TOTal", xlSum
    
    End Sub
    

提交回复
热议问题