如何使用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