求問：VBA 自動產生樞紐分析表

我用錄製方式寫了一個VBA 是在附件裏建立兩個樞紐分析表。不過運行的時候在下面這個位置卡住了。
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
      "sheet1!R1C1:R1048576C12", Version:=8).CreatePivotTable TableDestination:= _
      "sheet1!R1C26", TableName:="PivotTable21", DefaultVersion:=8
請幫我看看是哪裏出現問題。

另外能不能幫忙改良一下，
1) 欄Z -AA的樞紐分析表
資料來源從A1  - L1  :  A (欄B最後一行） -  L(欄B最後一行）
欄位清單：
列： SECTION & LENGTH
值：加總QTY

2) 欄AC-AD的樞紐分析表
資料來源從N1  - V1  :  N (欄P最後一行） -  V(欄P最後一行）
欄位清單：
列： SECTION & LENGTH
值：加總Q'TY

Sub Macro2()
  Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
      "sheet1!R1C1:R1048576C12", Version:=8).CreatePivotTable TableDestination:= _
      "sheet1!R1C26", TableName:="PivotTable21", DefaultVersion:=8
Sheets("sheet1)").Select
Cells(1, 26).Select
With ActiveSheet.PivotTables("PivotTable21")
      .ColumnGrand = True
      .HasAutoFormat = True
      .DisplayErrorString = False
      .DisplayNullString = True
      .EnableDrilldown = True
      .ErrorString = ""
      .MergeLabels = False
      .NullString = ""
      .PageFieldOrder = 2
      .PageFieldWrapCount = 0
      .PreserveFormatting = True
      .RowGrand = True
      .SaveData = True
      .PrintTitles = False
      .RepeatItemsOnEachPrintedPage = True
      .TotalsAnnotation = False
      .CompactRowIndent = 1
      .InGridDropZones = False
      .DisplayFieldCaptions = True
      .DisplayMemberPropertyTooltips = False
      .DisplayContextTooltips = True
      .ShowDrillIndicators = True
      .PrintDrillIndicators = False
      .AllowMultipleFilters = False
      .SortUsingCustomLists = True
      .FieldListSortAscending = False
      .ShowValuesRow = False
      .CalculatedMembersInFilters = False
      .RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable21").PivotCache
      .RefreshOnFileOpen = False
      .MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable21").RepeatAllLabels xlRepeatLabels
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable21").PivotFields("SECTION")
      .Orientation = xlRowField
      .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable21").PivotFields("LENGTH")
      .Orientation = xlRowField
      .Position = 2
End With
ActiveSheet.PivotTables("PivotTable21").AddDataField ActiveSheet.PivotTables( _
      "PivotTable21").PivotFields("QTY"), "Count of QTY", xlCount
With ActiveSheet.PivotTables("PivotTable21").PivotFields("Count of QTY")
      .Caption = "Sum of QTY"
      .Function = xlSum
End With
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

pivot table.rar (20.52 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

3^#

發表於 2024-2-22 15:59 | 只看該作者

本帖最後由 Andy2483 於 2024-2-22 16:40 編輯

回復 1# 198188

謝謝前輩發表此主題與範例
後學藉此帖學習到很多知識,學習方案如下,請前輩參考
執行結果:

Option Explicit
Sub TEST_P1()
[Z:AD].Delete
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Range([L1], [A65536].End(3)), Version:=4) _
.CreatePivotTable TableDestination:=[Z1], TableName:="PivotTable21", DefaultVersion:=4
With ActiveSheet.PivotTables("PivotTable21").PivotFields("SECTION")
.Orientation = xlRowField: .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable21").PivotFields("LENGTH")
.Orientation = xlRowField: .Position = 2
End With
ActiveSheet.PivotTables("PivotTable21").AddDataField ActiveSheet.PivotTables("PivotTable21").PivotFields("QTY"), "Sum of QTY", xlSum
'===============================================================================================
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Range([V2], [O65536].End(3)(1, 0)), Version:=4) _
.CreatePivotTable TableDestination:=[AC1], TableName:="PivotTable22", DefaultVersion:=4
With ActiveSheet.PivotTables("PivotTable22").PivotFields("NO.3")
.Orientation = xlRowField: .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable22").PivotFields("(M.)")
.Orientation = xlRowField: .Position = 2
End With
ActiveSheet.PivotTables("PivotTable22").AddDataField ActiveSheet.PivotTables("PivotTable22").PivotFields("(Pcs.)"), "Sum of QTY", xlSum
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

2^#

發表於 2024-2-22 12:09 | 只看該作者

我用錄製方式寫了一個VBA 是在附件裏建立兩個樞紐分析表。不過運行的時候在下面這個位置卡住了。
Activ ...
198188 發表於 2024-2-21 15:30

有沒有大大能幫忙做這個？

TOP