VBA创建枢轴

Question

我已经修改了一些我在互联网上发现的代码，这些代码正试图用来创建数据透视表。我为一个工作表使用了代号，因为它将用于工作表名称不同的多个工作簿。

当我运行以下代码时，它将创建一个数据透视表，但仅将区域作为单独的列

我想要的是行的姓氏和余额的帐户代码，每行末尾都有总数。

请查看代码，并帮助我获取此代码以正确填充行。

Sub InsertPivotTable()


 'Declare Variables
  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

 'Insert a New Blank Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  Worksheets("byAccount").Delete
  Sheets.Add After:=ActiveSheet
  ActiveSheet.Name = "byAccount"
  Application.DisplayAlerts = True
  Set PSheet = Worksheets("byAccount")
  Set DSheet = Worksheets(1)

 'Define Data Range
  LastRow = DSheet.Cells(Rows.Count, 4).End(xlUp).Row
  LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
  Set PRange = DSheet.Cells(4, 1).Resize(LastRow, LastCol)

 'Define Pivot Cache
  Set PCache = ActiveWorkbook.PivotCaches.Create _
  (SourceType:=xlDatabase, SourceData:=PRange). _
  CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
  TableName:="byAccountPivot")

'Insert Blank Pivot Table
 Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="byAccountPivot")

 'Insert Row Fields
  With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Surname")
 .Orientation = xlRowField
 .Position = 1
 End With

   With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Account Code")
  .Orientation = xlRowField
  .Position = 2
  End With

  'Insert Column Fields
   With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Amount")
  .Orientation = xlColumnField
  .Position = 1
  End With

 'Insert Data Field
 With ActiveSheet.PivotTables("byAccountPivot") 
 .PivotFields ("Amount")
 .Orientation = xlDataField
 .Function = xlSum
 .NumberFormat = "#,##0"
 .Name = "Amount"
 End With

'Format Pivot Table
 ActiveSheet.PivotTables("byAccountPivot").ShowTableStyleRowStripes = True
 ActiveSheet.PivotTables("byAccountPivot").TableStyle2 =      "PivotStyleMedium9"

 End Sub

Answer 1

感谢任何可能一直在研究此问题的人，但现在我已解决此问题，请参阅下面的修改代码。

Sub createPivot()
Dim PSheet As Worksheet, Dsheet As Worksheet
Dim PCache As PivotCache
Dim Ptable As PivotTable
Dim pRange As Range
Dim lastRow As Long
Dim lastCol As Long

 On Error Resume Next

Application.DisplayAlerts = False

Worksheets("by Account").Delete

Sheets.Add After:=ActiveSheet

ActiveSheet.Name = "by Account"

Set PSheet = Worksheets("by Account")
Set Dsheet = Sheets(1)

lastRow = Sheet6.UsedRange.Row + Sheet6.UsedRange.Rows.Count - 4
lastCol = Sheet6.UsedRange.Column + Sheet6.UsedRange.Columns.Count - 1

Set pRange = Dsheet.Cells(4, 1).Resize(lastRow, lastCol)


    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       pRange, Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:=PSheet.Cells(1, 1), TableName:="byAccountPivotTable", _
        DefaultVersion:=xlPivotTableVersion14


    ActiveSheet.PivotTables("byAccountPivotTable").AddDataField ActiveSheet.PivotTables( _
        "byAccountPivotTable").PivotFields("Amount"), "Sum of Amount", xlSum

     With ActiveSheet.PivotTables("byAccountPivotTable").PivotFields("Account Code")
        .Orientation = xlColumnField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("byAccountPivotTable").PivotFields("Surname")
       .Orientation = xlRowField
       .Position = 1
    End With


 End Sub