数据透视表没有按预期显示

时间:2015-11-20 02:46:59

标签: excel vba excel-vba pivot-table

我被要求为PivotTable制作宏代码。我已经完成了但是有一些错误,我不知道在这个函数AgingFur无法执行之后调用该函数。枢轴也没有像我预期的那样显示。

下面是我得到的数据透视表(Pivot Table A):

enter image description here

同时这是我应该得到的(Pivot Table B),它是手动生成的:

enter image description here

以下是我用来制作Pivot Table A的代码:

Sub AgingFur()
    Sheets("B_Original COpy").Activate
    Dim objTable As PivotTable, objField As PivotField, ws As Worksheet
    ActiveWorkbook.Sheets("B_Original COpy").Range("A1").Select

    Set ws = Sheets.Add
    ws.Name = "X_Aging ST Inc"

    Set objTable = Sheets("B_Original COpy").PivotTableWizard(TableDestination:=ws.Cells(1, "A"))
    objTable.PivotCache.MissingItemsLimit = xlmissingItemNone
    objTable.PivotCache.Refresh

    Set objField = objTable.PivotFields("Status")
    objField.Orientation = xlPageField
    objField.Position = 1
    objField.PivotItems("Cancelled").Visible = False

    Set objField = objTable.PivotFields("Month Opened")
    objField.Orientation = xlRowField

    Set objField = objTable.PivotFields("Age")
    objField.Orientation = xlDataField
    objField.Function = xlAverage
    objField.NumberFormat = "* #,##0.00"

    Set objField = objTable.PivotFields("Age FL")
    objField.Orientation = xlDataField
    objField.Function = xlAverage
    objField.NumberFormat = "* #,##0.00"

    With objTable.DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With
End Sub

我需要将Pivot显示为Pivot Table B并需要解决我不知道它在哪里的错误。请忽略显示的值。

我该如何解决这个问题?

函数AgingFur之前的代码是

Call KPIDashboardSheet    '<~ This one is Pivot
Call KPISecond            '<~ This one is Pivot
Call FactorizeData        '<~ This one is Pivot
Call AgingFur             '<~ The problem Pivot
Call SortWorksheets       '<~ This one for sort all sheets based on name

这是因子数据&#39;代码:

Private Sub FactorizeData()
Sheets("FactorizeData List").Activate
ActiveSheet.Range("A:AM").Copy
Sheets.Add.Name = "FactorizeData"
Sheets("FactorizeData List").Activate
Range("A:AM").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Call FactorizeDataTables
End Sub

Private Sub FactorizeDataTables()
Sheets("FactorizeData List").Activate
Dim objTable As PivotTable, objField As PivotField, ws As Worksheet
ActiveWorkbook.Sheets("FactorizeData List").Range("A1").Select

Set ws = Sheets.Add
ws.Name = "FactorizeData Table"

Set objTable = Sheets("FactorizeData List").PivotTableWizard(TableDestination:=ws.Cells(3, "A"))
objTable.PivotCache.MissingItemsLimit = xlmissingItemNone
objTable.PivotCache.Refresh

Set objField = objTable.PivotFields("Priority")
objField.Orientation = xlColumnField

Set objField = objTable.PivotFields("Status")
objField.Orientation = xlColumnField

Set objField = objTable.PivotFields("Type")
objField.Orientation = xlColumnField

Set objField = objTable.PivotFields("Date")
objField.Orientation = xlRowField

Set objField = objTable.PivotFields("Type")
objField.Orientation = xlDataField

Dim pf As PivotField
Set pf = ActiveSheet.PivotTables(1).PivotFields("Date")
pf.DataRange.Cells(1).Group Start:=True, End:=True, Periods:=Array(False, False, _
False, False, True, False, True)
End Sub

这是SortWorksheet:

Private Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean

SortDescending = False

If ActiveWindow.SelectedSheets.Count = 1 Then

    FirstWSToSort = 1
    LastWSToSort = Worksheets.Count
Else
    With ActiveWindow.SelectedSheets
        For N = 2 To .Count
            If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                Exit Sub
            End If
        Next N
        FirstWSToSort = .Item(1).Index
        LastWSToSort = .Item(.Count).Index
    End With
End If

For M = FirstWSToSort To LastWSToSort
    For N = M To LastWSToSort
        If SortDescending = True Then
            If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        End If
    Next N
Next M

End Sub

1 个答案:

答案 0 :(得分:0)

将此行添加到AgingFur程序

objTable.RowAxisLayout xlTabularRow

在此行之前

objTable.PivotCache.Refresh