数据透视表-将此数据添加到数据模型VBA

时间:2018-08-27 02:50:58

标签: excel vba excel-vba

我的VBA代码出现问题,该代码创建了将数据添加到数据模型的枢轴。我会逐步记录所有内容,这是我记录的代码。

以下是出现错误的代码部分:

Sub Pivot_Table_Slide1()
'
' Pivot_Table_Slide1 Macro
'

'
    Range("BJ1").Select
    ActiveCell.FormulaR1C1 = "Period"
    Range("BJ1").Select
    Selection.AutoFilter
    Range("BJ2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-43]<R2C19+7,""Week 1"",IF(RC[-43]<R2C19+14,""Week 2"",IF(RC[-43]<R2C19+21,""Week 3"",""Week 4"")))"
    Range("BJ2").Select
    Selection.AutoFill Destination:=Range("BJ2:BJ1971")
    Range("BJ2:BJ1971").Select
Range("BK2").Select
    Workbooks("IT FIRC2.xlsx").Connections.Add2 _
        "WorksheetConnection_IT Raw!$A$1:$BJ$1971", "", _
        "WORKSHEET;D:\Internship\[IT FIRC2.xlsx]IT Raw", "IT Raw!$A$1:$xBJ$1971" _
        , 7, True, False>
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ActiveWorkbook.Connections("WorksheetConnection_IT Raw!$A$1:$BJ$1971"), _
        Version:=6).CreatePivotTable TableDestination:="IT Raw!R2C63", TableName _
        :="PivotTable1", DefaultVersion:=6
    Workbooks("IT FIRC2.xlsx").Connections.Add2 _
        "WorksheetConnection_IT Raw!$A$1:$BJ$1971", "", _
        "WORKSHEET;D:\Internship\[IT FIRC2.xlsx]IT Raw", "IT Raw!$A$1:$BJ$1971" _
        , 7, True, False
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ActiveWorkbook.Connections("WorksheetConnection_IT Raw!$A$1:$BJ$1971"), _
        Version:=6).CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:= _
        "PivotTable2", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable").CubeFields("[Range].[firc_type]")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable").CubeFields.GetMeasure _
        "[Range].[proc_inst_id]", xlSum, "Sum of proc_inst_id"
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").CubeFields("[Measures].[Sum of proc_inst_id]"), _
        "Sum of proc_inst_id"
    With ActiveSheet.PivotTables("PivotTable2").CubeFields("[Range].[Period]")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields( _
        "[Measures].[Sum of proc_inst_id]")
        .Caption = "Distinct Count of proc_inst_id"
        .Function = xlDistinctCount
    End With
    Range("A4:E8").Select
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("Sheet1!$A$3:$F$9")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 204.75
    ActiveSheet.Shapes("Chart 1").IncrementTop -41.25
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    ActiveChart.ApplyLayout (6)
    ActiveChart.ChartArea.Select
    With ActiveChart.PivotLayout.PivotTable.CubeFields("[Range].[firc_type]")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveChart.PivotLayout.PivotTable.CubeFields("[Range].[Period]")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.ChartTitle.Select
    Selection.Delete
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ShowAllFieldButtons = False
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).AxisTitle.Select
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Cases"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "Total Cases"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 11).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 11).Font
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 10
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    ActiveChart.FullSeriesCollection(4).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With
    ActiveChart.FullSeriesCollection(3).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 0)
        .Transparency = 0
    End With
    Range("F13").Select
End Sub

我录制了此宏,即使我使用的是同一本工作簿,当我尝试使用它时也无法使用。

这是错误:

Error : subscript out of range:

0 个答案:

没有答案