如何使用vba创建透视表

Question

我是vba新手，正在尝试使用vba和Excel创建pivottable。

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

我试图添加区域、月份、编号、状态的行标签，值为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 so变量的使用。

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

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