You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

为何创建数据透视表的VBA脚本触发运行时错误5?

旧Excel可用的透视表VBA宏在Win11新Excel上报错

我编写了一个基于筛选数据创建数据透视表的VBA宏,在我的旧笔记本(非最新Excel版本)上运行正常,但同事的Win11笔记本上无法工作。不需要让宏更具动态性,只需要它按原逻辑运行即可。报错的是以下标注的代码段:

Sub Macro_Varasto_varannot()
'
' Macro_Varasto_varannot Macro
'

'
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "=Kaupinta Omistus", Operator:=xlOr, Criteria2:="=Omistus"
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11, Criteria1:=">0", Operator:=xlFilterValues
    
    Range("A1:M46").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets.Add
    ' ↓↓↓ 以下是报错代码段 ↓↓↓
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet2!R1C1:R161C13", Version:=8).CreatePivotTable TableDestination:= _
        "Sheet3!R3C1", TableName:="PivotTable2", DefaultVersion:=8
    ' ↑↑↑ 以上是报错代码段 ↑↑↑
    Sheets("Sheet3").Select
    Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Myyntialue"), "Count of Myyntialue", xlCount
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Projektinimi"), "Count of Projektinimi", xlCount
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Tuotenimi"), "Count of Tuotenimi", xlCount
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Myyntialue" _
        )
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Projektinimi" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tuotenimi" _
        )
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Määrä tn"), "Sum of Määrä tn", xlSum
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Arvo eur"), "Sum of Arvo eur", xlSum
    ActiveSheet.PivotTables("PivotTable2").CompactLayoutRowHeader = _
        "Myyntialue/projekti/tuotenimi"
    Range("B3").Select
    ActiveSheet.PivotTables("PivotTable2").DataPivotField.PivotItems( _
        "Sum of Määrä tn").Caption = "Summa / Määrä tn"
    Range("C3").Select
    ActiveSheet.PivotTables("PivotTable2").DataPivotField.PivotItems( _
        "Sum of Arvo eur").Caption = "Summa / Arvo eur"
    Range("G7").Select
    Columns("C:C").ColumnWidth = 20.83
    Columns("B:B").ColumnWidth = 22.17
    Sheets("Sheet1").Select
    Range("N29").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "=Omistus", Operator:=xlOr, Criteria2:="=Varanto"
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "Varanto"
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11, Criteria1:=">0", Operator _
        :=xlFilterValues
    Range("A1:M69").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet4!R1C1:R99C13", Version:=8).CreatePivotTable TableDestination:= _
        "Sheet5!R3C1", TableName:="PivotTable3", DefaultVersion:=8
    Sheets("Sheet5").Select
    Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Myyntialue"), "Count of Myyntialue", xlCount
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Projektinimi"), "Count of Projektinimi", xlCount
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Tuotenimi"), "Count of Tuotenimi", xlCount
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Myyntialue")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Projektinimi" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Tuotenimi")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Määrä tn"), "Sum of Määrä tn", xlSum
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
        "PivotTable3").PivotFields("Arvo eur"), "Sum of Arvo eur", xlSum
    ActiveSheet.PivotTables("PivotTable3").CompactLayoutRowHeader = _
        "Myyntialue/projekti/tuotenimi"
    Range("B3").Select
    ActiveSheet.PivotTables("PivotTable3").DataPivotField.PivotItems( _
        "Sum of Määrä tn").Caption = "Summa / Määrä tn"
    Range("C3").Select
    ActiveSheet.PivotTables("PivotTable3").DataPivotField.PivotItems( _
        "Sum of Arvo eur").Caption = "Summa / Arvo eur"
    Range("F5").Select
    Columns("C:C").ColumnWidth = 18.67
    Columns("B:B").ColumnWidth = 18
End Sub

问题原因与修复方案

核心问题

报错的直接原因是**Version:=8和DefaultVersion:=8参数在新版本Excel中不兼容**,该参数对应Excel 2007的透视表版本,Win11上的新版Excel已不再支持这个旧版本标识。另外,硬编码工作表名称(如Sheet2、Sheet3)可能因工作表创建顺序变化导致引用错误,也是潜在问题。

具体修复步骤

  1. 移除旧版本参数:删除PivotCaches.Create和CreatePivotTable中的Version:=8、DefaultVersion:=8参数,新版Excel会自动使用兼容的当前版本。
  2. 用变量引用新工作表:创建新工作表时将其赋值给变量,后续直接通过变量操作,避免硬编码名称出错。
  3. 减少Select/Selection操作:替换选择操作直接引用单元格/对象,提升宏的稳定性。

修改后的完整代码

Sub Macro_Varasto_varannot()
    Dim wsData1 As Worksheet, wsPivot1 As Worksheet
    Dim wsData2 As Worksheet, wsPivot2 As Worksheet
    
    ' 第一部分:筛选并复制数据,创建第一个透视表
    With ActiveSheet.ListObjects("Table1").Range
        .AutoFilter Field:=8, Criteria1:="=Kaupinta Omistus", Operator:=xlOr, Criteria2:="=Omistus"
        .AutoFilter Field:=11, Criteria1:=">0", Operator:=xlFilterValues
    End With
    
    ' 复制筛选后的数据到新工作表
    Set wsData1 = Sheets.Add(After:=ActiveSheet)
    Range("A1:M46").Resize(Range("A1:M46").End(xlDown).Row).Copy wsData1.Range("A1")
    Application.CutCopyMode = False
    
    ' 创建透视表工作表并生成透视表
    Set wsPivot1 = Sheets.Add(After:=wsData1)
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsData1.UsedRange).CreatePivotTable _
        TableDestination:=wsPivot1.Range("A3"), TableName:="PivotTable2"
    
    ' 配置第一个透视表字段
    With wsPivot1.PivotTables("PivotTable2")
        .AddDataField .PivotFields("Myyntialue"), "Count of Myyntialue", xlCount
        .AddDataField .PivotFields("Projektinimi"), "Count of Projektinimi", xlCount
        .AddDataField .PivotFields("Tuotenimi"), "Count of Tuotenimi", xlCount
        
        With .PivotFields("Myyntialue")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Projektinimi")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("Tuotenimi")
            .Orientation = xlRowField
            .Position = 3
        End With
        
        .AddDataField .PivotFields("Määrä tn"), "Sum of Määrä tn", xlSum
        .AddDataField .PivotFields("Arvo eur"), "Sum of Arvo eur", xlSum
        
        .CompactLayoutRowHeader = "Myyntialue/projekti/tuotenimi"
        .DataPivotField.PivotItems("Sum of Määrä tn").Caption = "Summa / Määrä tn"
        .DataPivotField.PivotItems("Sum of Arvo eur").Caption = "Summa / Arvo eur"
        
        wsPivot1.Columns("C:C").ColumnWidth = 20.83
        wsPivot1.Columns("B:B").ColumnWidth = 22.17
    End With
    
    ' 第二部分:重新筛选并创建第二个透视表
    With ActiveSheet.ListObjects("Table1").Range
        .AutoFilter Field:=11
        .AutoFilter Field:=8
        .AutoFilter Field:=8, Criteria1:="Varanto"
        .AutoFilter Field:=11, Criteria1:=">0", Operator:=xlFilterValues
    End With
    
    ' 复制筛选后的数据到新工作表
    Set wsData2 = Sheets.Add(After:=ActiveSheet)
    Range("A1:M69").Resize(Range("A1:M69").End(xlDown).Row).Copy wsData2.Range("A1")
    Application.CutCopyMode = False
    
    ' 创建透视表工作表并生成透视表
    Set wsPivot2 = Sheets.Add(After:=wsData2)
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsData2.UsedRange).CreatePivotTable _
        TableDestination:=wsPivot2.Range("A3"), TableName:="PivotTable3"
    
    ' 配置第二个透视表字段
    With wsPivot2.PivotTables("PivotTable3")
        .AddDataField .PivotFields("Myyntialue"), "Count of Myyntialue", xlCount
        .AddDataField .PivotFields("Projektinimi"), "Count of Projektinimi", xlCount
        .AddDataField .PivotFields("Tuotenimi"), "Count of Tuotenimi", xlCount
        
        With .PivotFields("Myyntialue")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Projektinimi")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("Tuotenimi")
            .Orientation = xlRowField
            .Position = 3
        End With
        
        .AddDataField .PivotFields("Määrä tn"), "Sum of Määrä tn", xlSum
        .AddDataField .PivotFields("Arvo eur"), "Sum of Arvo eur", xlSum
        
        .CompactLayoutRowHeader = "Myyntialue/projekti/tuotenimi"
        .DataPivotField.PivotItems("Sum of Määrä tn").Caption = "Summa / Määrä tn"
        .DataPivotField.PivotItems("Sum of Arvo eur").Caption = "Summa / Arvo eur"
        
        wsPivot2.Columns("C:C").ColumnWidth = 18.67
        wsPivot2.Columns("B:B").ColumnWidth = 18
    End With
End Sub

内容的提问来源于stack exchange,提问作者jukuii

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.21 22:54:19