运行时错误5：Excel VBA

Question

我已经创建了一个宏，用于从数据表“ Sheet1”中的“数据透视表”中创建数据透视表。

尽管我可以在我的系统中运行宏，但在其他系统中却可以在ActiveWorkbook.PivotCaches.Create行中看到运行时错误5。

Sub Make_Pivot()
'
' Make_Pivot Macro

Sheets("Sheet1").Select
Columns("D:G").Select
Range("G1").Activate

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C4:R1048576C7", Version:=6).CreatePivotTable TableDestination:= _
        "Pivot!R1C1", TableName:="PivotTable1", DefaultVersion:=6

Sheets("Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("NDL")
    .Orientation = xlRowField
    .Position = 1
End With

ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Tracking IDs"), "Count of Tracking IDs", xlCount

Columns("A:B").Select
Range("B1").Activate
Selection.Copy
Range("G13").Select
Sheets("Count").Select
Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("F18").Select

End Sub   

Answer 1

尝试下面的动态代码（代码内的注释说明）：

Option Explicit

Sub Make_Pivot()

' Make_Pivot Macro

Dim WB As Workbook
Dim ws As Worksheet
Dim PvtSht As Worksheet
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim SrcData As Range
Dim LastRow As Long

' set the workbook object
Set WB = ThisWorkbook

' set the worksheet object where the Pivot-Table will be
Set PvtSht = ThisWorkbook.Worksheets("Pivot")

' set the worksheet object where the Data lies
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
    LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row ' <-- last row in column "G"
    ' set the Pivot-Cache SourceData object
    Set SrcData = .Range("D1:G" & LastRow)
End With

' Create the Pivot Cache
Set PvtCache = WB.PivotCaches.Create(SourceType:=xlDatabase, _
                                SourceData:=SrcData.Address(False, False, xlA1, xlExternal))
' === FOR DEBUG ONLY ===
MsgBox PvtCache.SourceData

' Set the Pivot Table Object (already created in previous macro run)
On Error Resume Next
Set PvtTbl = PvtSht.PivotTables("PivotTable1")

On Error GoTo 0
If PvtTbl Is Nothing Then ' <-- pivot table still doesn't exist >> need to create it
    ' create a new Pivot Table in "Pivot" sheet, start from Cell A1
    Set PvtTbl = PvtSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PvtSht.Range("A1"), TableName:="PivotTable1")

    With PvtTbl
        With .PivotFields("NDL")
            .Orientation = xlRowField
            .Position = 1
        End With

        .AddDataField .PivotFields("Tracking IDs"), "Count of Tracking IDs", xlCount
    End With
Else
    ' just refresh the Pivot table, with updated Pivot Cache
    PvtTbl.ChangePivotCache PvtCache
    PvtTbl.RefreshTable
End If

' rest of your code goes here ...

End Sub

注意 ：不需要使用那么多的Select和Selection ，而是使用完全限定的Range ， Worksheet和Object 。