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

Question

我是vba的新手,我正在尝试PivotTable使用excel 创建一个使用VBA.

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

我想补充的行标签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