VBA для создания пивота - PullRequest
       12

VBA для создания пивота

0 голосов
/ 13 февраля 2019

Desired outputResult from running the code

Data Source Я исправил какой-то код, который я нашел в Интернете, который я пытаюсьиспользовать для создания сводной таблицы.Я использовал кодовое имя для одного листа, потому что он будет использоваться в нескольких книгах, чье имя листа будет другим.

Когда я запускаю приведенный ниже код, он создает сводную таблицу, но с областью в виде одиночного столбца

Мне нужны только фамилии для строк и коды счетов для сальдо с итогом в конце каждой строки.

Пожалуйста, посмотрите код, и помогите мне получить это для правильного заполнения строк.

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

1 Ответ

0 голосов
/ 14 февраля 2019

Спасибо всем, кто возможно смотрел на это, но я исправил это сейчас, пожалуйста, смотрите исправленный код ниже.

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
...