如何使用vba创建数据透视表

Question

我是vba的新手，并且正尝试使用excel创建使用VBA的PivotTable。

我想创建像下面的图像作为输入表。

我想补充的region，month，number，status行标签和值value1，value2和total我在这里可以设置范围为支点，在执行它创建“数据透视表”表只要。不会为sheet1生成任何数据透视表。

我的代码：

Option Explicit 

Public Sub Input_File__1() 

ThisWorkbook.Sheets(1).TextBox1.Text = Application.GetOpenFilename() 

End Sub 

'====================================================================== 

Public Sub Output_File_1() 

Dim get_fldr, item As String 
Dim fldr As FileDialog 

Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 
With fldr 
    .AllowMultiSelect = False 
    If .Show <> -1 Then GoTo nextcode: 

    item = .SelectedItems(1) 
    If Right(item, 1) <> "\" Then 
     item = item & "\" 
    End If 
End With 

nextcode: 
get_fldr = item 
Set fldr = Nothing 
ThisWorkbook.Worksheets(1).TextBox2.Text = get_fldr 

End Sub 

'====================================================================== 

Public Sub Process_start() 

Dim Raw_Data_1, Output As String 
Dim Raw_data, Start_Time As String 
Dim PSheet As Worksheet 
Dim DSheet As Worksheet 
Dim PCache As PivotCache 
Dim PTable As PivotTable 
Dim PRange As Range 
Dim LastRow As Long 
Dim LastCol As Long 

Start_Time = Time() 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text 
Output = ThisWorkbook.Sheets(1).TextBox2.Text 

Workbooks.Open Raw_Data_1: Set Raw_data = ActiveWorkbook 
Raw_data.Sheets("Sheet1").Activate 

On Error Resume Next 

'Worksheets("Sheet1").Delete 
Sheets.Add before:=ActiveSheet 
ActiveSheet.Name = "Pivottable" 

Application.DisplayAlerts = True 

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).coloumn 
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 

Answer 1

这需要一些整理，但应该让你开始。

请注意使用Option Explicit，因此必须声明变量。

列名称与您提供的工作簿相同。

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 

Answer 2

我在下面的答案中的代码有点长，但它应该为您提供您正在寻找的结果。

首先，为了安全起见，首先检查"Pivottable"工作表是否已存在于Raw_data工作簿对象中（无需再次创建）。

二，代码在中间分为2个部分：

1. 如果宏是前跑（这是你正在运行它的2+倍），然后"PRIMEPivotTable"枢轴表已创建，并且不需要再次创建它，或者设置Pivot-Table的字段。 您只需刷新PivotTable并更新PivotCache（使用更新的Pivot-Cache的源范围）。
2. 如果这是第一次运行这个MACRO，那么你需要设置PivotTable和所有必要的PivotFields。

详细解释每一步代码的注释。

代码

Option Explicit 

Sub AutoPivot() 

Dim Raw_data As Workbook 
Dim PSheet As Worksheet 
Dim DSheet As Worksheet 
Dim PTable As PivotTable 
Dim PCache As PivotCache 
Dim PRange As Range 
Dim LastRow As Long, LastCol As Long 
Dim Raw_Data_1 As String, Output As String, Start_Time As String 

Start_Time = Time() 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text 
Output = ThisWorkbook.Sheets(1).TextBox2.Text 

' set the WorkBook object 
Set Raw_data = Workbooks.Open(Raw_Data_1) 

Set DSheet = Raw_data.Worksheets("Sheet1") 

' first check if "Pivottable" sheet exits (from previous MACRO runs) 
On Error Resume Next 
Set PSheet = Raw_data.Sheets("Pivottable") 
On Error GoTo 0 

If PSheet Is Nothing Then ' 
    Set PSheet = Raw_data.Sheets.Add(before:=Raw_data.ActiveSheet) ' create a new worksheet and assign the worksheet object 
    PSheet.Name = "Pivottable" 
Else ' "Pivottable" already exists 
    ' do nothing , or something else you might want 

End If 

With DSheet 
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 

    ' set the Pivot-Cache Source Range with the values found for LastRow and LastCol 
    Set PRange = .Range("A1", .Cells(LastRow, LastCol)) 
End With 

' set a new/updated Pivot Cache object 
Set PCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address(True, True, xlA1, xlExternal)) 

' add this line in case the Pivot table doesn't exit >> first time running this Macro 
On Error Resume Next 
Set PTable = PSheet.PivotTables("PRIMEPivotTable") ' check if "PRIMEPivotTable" Pivot-Table already created (in past runs of this Macro) 

On Error GoTo 0 
If PTable Is Nothing Then ' Pivot-Table still doesn't exist, need to create it 
    ' create a new Pivot-Table in "Pivottable" sheet 
    Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="PRIMEPivotTable") 

    With PTable 
     ' add the row fields 
     With .PivotFields("Region") 
      .Orientation = xlRowField 
      .Position = 1 
     End With 
     With .PivotFields("month") 
      .Orientation = xlRowField 
      .Position = 2 
     End With 
     With .PivotFields("number") 
      .Orientation = xlRowField 
      .Position = 3 
     End With 
     With .PivotFields("Status") 
      .Orientation = xlRowField 
      .Position = 4 
     End With 

     ' add the 3 value fields (as Sum of..) 
     .AddDataField .PivotFields("value1"), "Sum of value1", xlSum 
     .AddDataField .PivotFields("value2"), "Sum of value2", xlSum 
     .AddDataField .PivotFields("TOTal"), "Sum of TOTal", xlSum 
    End With 

Else ' Pivot-Table "PRIMEPivotTable" already exists >> just update the Pivot-Table with updated Pivot-Cache (update Source Range) 

    ' just refresh the Pivot cache with the updated Range 
    PTable.ChangePivotCache PCache 
    PTable.RefreshTable 
End If 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub