如何使用vba创建数据透视表
问题描述:
我是vba的新手,并且正尝试使用excel创建使用VBA的PivotTable
。如何使用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
答
这需要一些整理,但应该让你开始。
请注意使用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
+0
也不错,只是模块化'PivotFields'的名字来匹配这篇文章:) –
答
我在下面的答案中的代码有点长,但它应该为您提供您正在寻找的结果。
首先,为了安全起见,首先检查"Pivottable"
工作表是否已存在于Raw_data
工作簿对象中(无需再次创建)。
二,代码在中间分为2个部分:
- 如果宏是前跑(这是你正在运行它的2+倍),然后
"PRIMEPivotTable"
枢轴表已创建,并且不需要再次创建它,或者设置Pivot-Table的字段。 您只需刷新PivotTable
并更新PivotCache
(使用更新的Pivot-Cache的源范围)。 - 如果这是第一次运行这个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
什么错误,你得到和在哪里?这里至少有一个拼写错误LastCol = DSheet.Cells(1,Columns.Count).End(xlToLeft).coloumn QHarr
注释掉错误继续旁边的代码并用F8逐步查看代码,看看问题出在哪里也许。在问题中明确说明什么不是你想要的方式和你尝试过的方式。是否有一些代码丢失? – QHarr
枢轴不为第一行创建区域 –