创建数据透视表时出错

时间:2017-06-20 13:12:33

标签: excel vba excel-vba

我正在编写代码来创建数据透视表。我录制了宏,然后将其简化为易于理解。

执行代码时,出现错误

  

下标超出范围。

我查看了工作表名称,它与我定义的名称相同。

我很无能为力,为什么它不起作用。下面是我试过的代码。

 Sub table()
    Dim pvtcache As PivotCache
    Dim pvttbl As pivottable
    Dim pvtsht As Worksheet

    Set pvtcache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
      "Preparation Sheet!R1C1:R1048576C9")       
    Set pvtsht = Worksheets("LP")

    On Error Resume Next
      Set pvttbl = pvtsht.PivotTables("PivotTable3")
    On Error GoTo 0

    If pvttbl Is Nothing Then
        Set pvttbl = pvtsht.PivotTables.Add(PivotCache:=pvtcache, TableDestination:=pvtsht.Range("A3"), TableName:="PivotTable3")

        With pvttbl
            With .PivotFields("DL")
                .Orientation = xlRowField
                .Position = 1
            End With
            With .PivotFields("Colour")
                .Orientation = xlColumnField
                .Position = 1
            End With
        End With   
    Else
        ' just refresh the Pivot cache with the updated Range
        pvttbl.ChangePivotCache pvtcache
    End If
End Sub
下面的代码来自宏

Sub Macro8() 
    Sheets.Add

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
      "Preparation Sheet!R1C1:R1048576C9", Version:=xlPivotTableVersion15). _
      CreatePivotTable TableDestination:="Sheet4!R3C1", TableName:="PivotTable2" _
      , DefaultVersion:=xlPivotTableVersion15

    Sheets("Sheet4").Select
    Cells(3, 1).Select

    With ActiveSheet.PivotTables("PivotTable2").PivotFields("DL")
        .Orientation = xlRowField
        .Position = 1
    End With

    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
      "PivotTable2").PivotFields("Colour"), "Count of Colour", xlCount

    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Colour")
        .Orientation = xlColumnField
        .Position = 1
    End With
End Sub

1 个答案:

答案 0 :(得分:0)

如果您的工作表名称包含空格"Preparation Sheet!R1C1:R1048576C9",则需要将工作表名称括在''

"'Preparation Sheet'!R1C1:R1048576C9"

或避免空格。

修改

将此功能添加到您的模块

Public Function PivotTableExistsInWorksheet(pvWorksheet As Worksheet, pvTableName As String) As Boolean
    Dim pvTable As PivotTable

    PivotTableExistsInWorksheet = False 'Default

    For Each pvTable In pvWorksheet.PivotTables
        If pvTable.Name = pvTableName Then
            PivotTableExistsInWorksheet = True
            Exit Function
        End If
    Next pvTable
End Function

并使用

If PivotTableExistsInWorksheet(pvtsht, "PivotTable3") Then
    Set pvttbl = pvtsht.PivotTables("PivotTable3")
End If

而不是On Error Resume Next … Goto 0块,看看是否有效。