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

198188

我用錄製方式寫了一個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

198188

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

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

Andy2483

回復 1# 198188


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

下載 (298.7 KB)

2024-2-22 16:39

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