未添加计算的枢轴字段

时间:2019-03-26 07:31:47

标签: excel vba

我已经运行此宏数千次,并按预期工作,但是突然之间不再存在:

Sub CrearTablaAgentes()

    Dim i As Byte, arr1, arr2, wsPvT As Worksheet, PvT As PivotTable, LastRow As Long, PvTFld As PivotField

    Call NuevaHoja("TablaProgramados")
    Set wsPvT = wb.Sheets("TablaProgramados")
    With wb.Sheets("Mapa Turnos")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set PvT = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Mapa Turnos!R1C1:R" & LastRow & "C55", Version:=xlPivotTableVersion14). _
        CreatePivotTable(TableDestination:=wsPvT.Name & "!R1C1", TableName:="TablaProgramados", DefaultVersion:=xlPivotTableVersion14)

    With PvT
        .ColumnGrand = False
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = False
        .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
        .PivotCache.RefreshOnFileOpen = False
        .PivotCache.MissingItemsLimit = xlMissingItemsDefault
    End With

    With PvT.PivotFields("Fecha")
        .Orientation = xlRowField
        .Position = 1
    End With
    With PvT.PivotFields("Modo")
        .Orientation = xlRowField
        .Position = 2
    End With
    With PvT.PivotFields("Centro")
        .Orientation = xlRowField
        .Position = 3
    End With
    PvT.RowAxisLayout xlTabularRow
    PvT.RepeatAllLabels xlRepeatLabels

    arr1 = Array("0:00", "0:30", "1:00", "1:30", "2:00", "2:30", "3:00", "3:30", "4:00", "4:30", "5:00", "5:30", "6:00", "6:30", "7:00", "7:30", "8:00", "8:30", "9:00", "9:30", "10:00", "10:30", "11:00", "11:30", "12:00", "12:30", "13:00", "13:30", "14:00", "14:30", "15:00", "15:30", "16:00", "16:30", "17:00", "17:30", "18:00", "18:30", "19:00", "19:30", "20:00", "20:30", "21:00", "21:30", "22:00", "22:30", "23:00", "23:30")
    arr2 = Array("Total", "Mañana", "Tarde", "Noche")
    PvT.ManualUpdate = True
    For i = 0 To 47
        PvT.CalculatedFields.Add STR(i), "=IFERROR('" & CDate(arr1(i)) & "' /30,0)", True
        PvT.PivotFields(STR(i)).Orientation = xlDataField
    Next i

    With PvT.CalculatedFields
        .Add "Noche", "=('0'+'1'+'2'+'3'+'4'+'5'+'6'+'7'+'8'+'9'+'10'+'11'+'12'+'13'+'14'+'15')/2", True
        .Add "Mañana", "=('16'+'17'+'18'+'19'+'20'+'21'+'22'+'23'+'24'+'25'+'26'+'27'+'28'+'29'+'30'+'31')/2", True
        .Add "Tarde", "= ('32'+'33'+'34'+'35'+'36'+'37'+'38'+'39'+'40'+'41'+'42'+'43'+'44'+'45'+'46'+'47')/2", True
        .Add "Total", "='Noche'+'Mañana'+'Tarde'", True
    End With
    For i = 0 To UBound(arr2)
        PvT.PivotFields(arr2(i)).Orientation = xlDataField
    Next i
    PvT.ManualUpdate = False

End Sub

此行:PvT.CalculatedFields.Add STR(i), "=IFERROR('" & CDate(arr1(i)) & "' /30,0)", True 应该计算新字段时什么也不做。如果在手动执行过程中记录该过程,则会得到相同的结果:

ActiveSheet.PivotTables("TablaProgramados").CalculatedFields.Add "0", _
    "='00:00' /30", True
ActiveSheet.PivotTables("TablaProgramados").PivotFields("0").Orientation = _
    xlDataField

数据透视表的外观如下:

Pivot Table

但是在VBA运行时,它将无法正常工作,并且会在尝试将其添加到数据透视表的下一行中引发错误。有什么想法吗?

0 个答案:

没有答案
相关问题