如何用VBA Macro打开Excel工作簿并创建Pivot table？报错求助

问题描述 #

我想要编写一个VBA宏，实现从文件夹打开指定Excel文件并在该文件中创建数据透视表相关统计。目前已分别编写了两个独立的宏，可各自完成上述两项操作，但合并为一个宏后运行时出现“Run-time error '1004': Application-defined or object-defined error”错误，尝试的代码如下：

Sub Call_a_Macro()

    'Path of the file that has the macro
    Workbooks.Open ("C:\Users\User\File_ABC.xlsm")
    
    'Create the Pivot Table
    ActiveWorkbook.Worksheets("Sheet1").Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table2").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table2").Sort.SortFields. _
        Add2 Key:=Range("Table2[[#All],[Location]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "BC"
    Range("F9").Select
    ActiveCell.FormulaR1C1 = "ON"
    Range("F10").Select
    ActiveCell.FormulaR1C1 = "SK"
    Range("F11").Select
    ActiveCell.FormulaR1C1 = "MK"
    Range("F12").Select
    ActiveCell.FormulaR1C1 = "SS"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "RR"
    Range("F14").Select
    ActiveCell.FormulaR1C1 = "AC"
    Range("F15").Select
    ActiveCell.FormulaR1C1 = "IO"
    Range("G8").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*BC*"")"
    Range("G9").Select
    ActiveWindow.SmallScroll Down:=-6
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*ON*"")"
    Range("G10").Select
    ActiveWindow.SmallScroll Down:=-8
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""SK*"")"
    Range("G11").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*MK*"")"
    Range("G11").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*SS*"")"
    Range("G12").Select
    ActiveWindow.SmallScroll Down:=-10
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*RR*"")"
    Range("G13").Select
    ActiveWindow.SmallScroll Down:=-11
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(Table2[[#All],[Location]],""*AC*"")"
    Range("G14").Select
    ActiveWindow.SmallScroll Down:=-12
    ActiveCell.FormulaR1C1 = "=COUNTIF(Table2[[#All],[Program]],""AC*"")"
    Range("G15").Select
    ActiveWindow.SmallScroll Down:=-13
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(Table2[[#All],[Location]],""*DE*"")-R[-1]C"
    Range("G16").Select

End Sub

错误原因分析 #

1. 过度依赖ActiveWorkbook、ActiveSheet和Select操作：打开文件后活动工作簿可能未及时切换，或引用范围时未明确归属的工作表/工作簿，导致对象引用失效。
2. 录制宏生成的代码大量使用Select和ActiveCell，这类写法稳定性极差，任何焦点变化都可能触发错误。

修正后的代码 #

Sub OpenFileAndCreateStats()
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim dataTable As ListObject
    Dim lastCol As Long, lastRow As Long
    Dim dataRange As Range
    
    ' 明确引用打开的目标工作簿
    Set targetWB = Workbooks.Open("C:\Users\User\File_ABC.xlsm")
    ' 明确引用目标工作表
    Set targetWS = targetWB.Worksheets("Sheet1")
    
    ' 计算数据范围（替代多次Select操作）
    lastCol = targetWS.Cells(1, targetWS.Columns.Count).End(xlToLeft).Column
    lastRow = targetWS.Cells(targetWS.Rows.Count, 1).End(xlUp).Row
    Set dataRange = targetWS.Range(targetWS.Cells(1, 1), targetWS.Cells(lastRow, lastCol))
    
    ' 创建结构化表格并设置名称
    Set dataTable = targetWS.ListObjects.Add(xlSrcRange, dataRange, , xlYes)
    dataTable.Name = "Table2"
    
    ' 对表格按Location列排序
    With dataTable.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=dataTable.ListColumns("Location").Range, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' 批量填写Location标识
    targetWS.Range("F8:F15").Value = Array("BC", "ON", "SK", "MK", "SS", "RR", "AC", "IO")
    
    ' 批量设置统计公式
    With targetWS
        .Range("G8").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*BC*"")"
        .Range("G9").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*ON*"")"
        .Range("G10").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*MK*"")"
        .Range("G11").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*SS*"")"
        .Range("G12").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*RR*"")"
        .Range("G13").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*AC*"")"
        .Range("G14").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Program]],""AC*"")"
        .Range("G15").FormulaR1C1 = "=COUNTIF(Table2[[#All],[Location]],""*DE*"")-R[-1]C"
    End With
End Sub

关键修正点 #

• 用变量targetWB和targetWS明确引用对象，彻底摆脱对ActiveWorkbook/ActiveSheet的依赖。
• 取消所有Select、ActiveCell和滚动操作，直接通过对象引用操作单元格，避免焦点变化引发错误。
• 批量填写标识和设置公式，简化代码结构，提升运行效率。
• 引用表格列时使用dataTable.ListColumns("Location").Range，避免范围引用混乱。

内容的提问来源于stack exchange，提问作者Konain Qurban