我是 vba 新手,正在尝试创建一个PivotTable
使用 VBA 和 Excel。
我想创建如下图所示的输入表。
![Image of data](https://i.stack.imgur.com/RwF4S.png)
我正在尝试添加行标签region
, month
, number
, status
和价值观是value1
, value2
and total
在这里,我可以设置枢轴的范围,同时执行它仅创建“可枢转”工作表。不为sheet1 生成任何数据透视表。
My Code:
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
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)