如何使用VBA创建数据透视表 [英] How to create pivot table using vba
问题描述
我是vba的新手,正在尝试使用带有Excel的VBA创建PivotTable
.
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.
我尝试添加region
,month
,number
,status
的行标签,值分别为value1
,value2
和total
,在这里我可以设置数据透视的范围,执行时仅创建可旋转"工作表.不会为sheet1生成任何数据透视表.
I am trying to add row labels of region
, month
, number
, status
and values are value1
, value2
and total
here I am able to set range for pivot, while executing it creates "pivottable" sheet only. not generate any pivot table for 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
推荐答案
这需要进行一些整理,但应该可以让您入门.
This needs some tidying up but should get you started.
请注意使用Option Explicit,因此必须声明变量.
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
这篇关于如何使用VBA创建数据透视表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!