將帶過濾器的資料透視表添加到回圈中

我仍在學習 VBA，我正在嘗試讓我當前的代碼回圈過濾所有具有相同欄位和列的可用資料透視表。但是，我無法激活回圈中的樞軸。請參考我下面的代碼，問題以“插入樞軸欄位”開頭。任何幫助表示贊賞。

'Loop through array for sheet names
For n = UBound(wsNames) To LBound(wsNames) Step -1
Set subWS = wb.Worksheets.Add(After:=ws)
'rename ws using sheet names array
subWS.Name = wsNames(n)
If IsArray(ccNumbers(n)) Then 'multiple group numbers in array
    dataRG.AutoFilter 7, ccNumbers(n), xlFilterValues
Else
    dataRG.AutoFilter 7, ccNumbers(n) 'x;And' is default (irrelevant)
End If
Set dfCell = subWS.Range("A1")
'copy column widths
dataRG.Rows(1).Copy
dfCell.PasteSpecial xlPasteColumnWidths
'select first cell as selection is first row by product of 'PasteSpecial
dfCell.Select
'copy visible cells only
dataRG.SpecialCells(xlCellTypeVisible).Copy dfCell
'set range for subws
Set subRG = subWS.Range("A1").CurrentRegion
'Format each sheet as a table
subWS.ListObjects.Add(SourceType:=xlSrcRange, Source:=subRG).Name = TbleNames(n)
'Add new WS for pivots
Set pvtWS = Sheets.Add(After:=subWS)
pvtWS.Name = PvtNames(n)
'Define Pivot Caches
Set subCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=subRG)
'Create Pivot Tables
Set subPvtTable = subCache.CreatePivotTable(TableDestination:=pvtWS.Cells(1, 1))
subPvtTable.Name = PTNames(n)

'Insert Fields for Pivot
With ActiveTable.subPvtTable

'Insert Filters for Pivot
With .pivotfields("Cost Center")
.Orientation = xlPageField
.Position = 1
End With

'Insert Row Fields for Pivot
With .pivotfields("OrgName")
.Orientation = xlRowField
.Position = 1
End With

'Insert Value Fields for Pivot
With .pivotfields("Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "$#,##0.00"
End With


End With
next n

uj5u.com熱心網友回復：

修復With并增加測驗是否隱藏所有資料行，避免添加子表和資料透視表的兩張表。

'Loop through array for sheet names
For n = UBound(wsNames) To LBound(wsNames) Step -1
    
    If IsArray(ccNumbers(n)) Then 'multiple group numbers in array
        dataRG.AutoFilter 7, ccNumbers(n), xlFilterValues
    Else
        dataRG.AutoFilter 7, ccNumbers(n) 'x;And' is default (irrelevant)
    End If
    'were all data rows filtered out?
    If dataRG.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then  'FIXED
        Set subWS = wb.Worksheets.Add(After:=ws)
        subWS.Name = wsNames(n) 'rename ws using sheet names array
        
        Set dfCell = subWS.Range("A1")
        dataRG.Rows(1).Copy 'copy column widths
        dfCell.PasteSpecial xlPasteColumnWidths
        dataRG.SpecialCells(xlCellTypeVisible).Copy dfCell 'copy visible cells only
        
        Set subRG = subWS.Range("A1").CurrentRegion
        subWS.ListObjects.Add(SourceType:=xlSrcRange, Source:=subRG).Name = TbleNames(n)
        
        Set pvtWS = Sheets.Add(After:=subWS)
        pvtWS.Name = PvtNames(n)
        
        Set subCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=subRG)
        Set subPvtTable = subCache.CreatePivotTable(TableDestination:=pvtWS.Cells(1, 1))
        subPvtTable.Name = PTNames(n)
        
        With subPvtTable
            With .PivotFields("Cost Center")
                .Orientation = xlPageField
                .Position = 1
            End With
            With .PivotFields("OrgName")
                .Orientation = xlRowField
                .Position = 1
            End With
            With .PivotFields("Amount")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "$#,##0.00"
            End With
        End With
    End If 'any filtered data
Next n

標籤：擅长VBA循环枢数据透视表

上一篇：從vba中的陣列中間洗掉一個專案

下一篇：從UserControl引發的WPFMVVM依賴屬性不會轉到用戶控制元件容器