Office 365单台电脑运行XGetScore宏触发1004错误求助

所有电脑均已确认使用最新版Office 365。测试评分宏包含三个子程序：

• 粘贴待评分数据及答案：运行正常
• 生成仅复制类别不含答案的测试：运行正常
• 启动评分流程的XCheckColumnData：运行正常，但后续执行XGetScore子程序时触发运行时错误'1004':应用定义或对象定义错误，报错代码行：

ActiveCell.FormulaR1C1 = _
"=[@[" & BoolArgument1(I) & "]]=[@[" & BoolArgument2(I) & "]]"

报错前执行的XCheckColumnData子程序代码 #

Sub XCheckColumnData()

    Call XDeleteChecks

Dim ranges, columnheader, newcolumnheaders, columnletters, lookupcolumns As Variant
ranges = Array("I:I", "K:K", "M:M", "AE:AE", "AG:AG")
columnheaders = Array("[Column1]", "[Column1]", "[Column1]", "[3 in 1]", "[Column1]")
newcolumnheaders = Array("CPU Check", "FF Check", "OEM Check", "2in1 Check", "Chrome Check")
columnletters = Array("I2", "K2", "M2", "AE2", "AG2")
lookupcolumns = Array("Processor Number", "Form Factor Category", "OEM Brand", "2 in 1", "Chromebook")

Sheets("Platinum").Select

For I = 0 To 4
J = 0

    Columns(ranges(I)).Select
    Selection.Insert Shift:=xlToRight
    Range("Table1[[#Headers]," & columnheaders(I) & "]").FormulaR1C1 = newcolumnheaders(I)
    Range("Table1[" & newcolumnheaders(I) & "]").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range(columnletters(I)).Select
    ActiveCell.FormulaR1C1 = _
        "=INDEX(Table2,MATCH([@[Product Identifier]],Table2[Part Number],0),MATCH(""" & lookupcolumns(I) & """,Table2[#Headers],0))"
    
Next I
End Sub

触发错误的XGetScore子程序代码 #

Sub XGetScore()
Dim BoolColumn, BoolName, BoolArgument1, BoolArgument2 As Variant
BoolColumn = Array("AS", "AT", "AU", "AV", "AW", "AX")
BoolName = Array("CPU Bool", "FF Bool", "OEM Bool", "2in1 Bool", "Chrome Bool", "Row Error")
BoolArgument1 = Array("Processor Number", "Form Factor Category", "OEM Brand", "2 in 1", "Chromebook")
BoolArgument2 = Array("CPU Check", "FF Check", "OEM Check", "2in1 Check", "Chrome Check")
I = 0

For I = 0 To 5
Range(BoolColumn(I) & "1").Select
ActiveCell.FormulaR1C1 = BoolName(I)
Range(BoolColumn(I) & "2").Select

If I < 5 Then
ActiveCell.FormulaR1C1 = _
    "=[@[" & BoolArgument1(I) & "]]=[@[" & BoolArgument2(I) & "]]"
ElseIf I = 5 Then
Range("AX2").Formula = _
    "=AND(AS2:AW2)"
End If

Next I


End Sub

问题原因分析 #

1. 结构化引用范围失效：报错行的[@[列名]]是Excel表格的结构化引用，要求写入公式的单元格必须属于目标ListObject（即Table1）。但XGetScore中直接选择BoolColumn(I)&"2"单元格写入公式，若该单元格不在Table1范围内，结构化引用会直接失效，触发1004错误。
2. 依赖Select/ActiveCell的不稳定性：代码大量使用Select和ActiveCell操作，容易受当前工作表激活状态、表格范围变化影响，导致引用目标偏离预期。
3. 循环边界冗余：BoolArgument1和BoolArgument2仅包含5个元素，但循环I=0 To 5会额外执行一次无效循环，虽不是本次报错直接原因，但存在越界风险。

修复方案 #

方案1：绑定表格对象，避免Select操作 #

直接通过ListObject对象操作表格，确保公式写入正确的表格列范围内，彻底消除结构化引用失效问题：

Sub XGetScore()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim BoolName, BoolArgument1, BoolArgument2 As Variant
    Dim i As Integer
    
    ' 绑定目标工作表和表格，避免Select操作
    Set ws = ThisWorkbook.Sheets("Platinum")
    Set tbl = ws.ListObjects("Table1")
    
    BoolName = Array("CPU Bool", "FF Bool", "OEM Bool", "2in1 Bool", "Chrome Bool", "Row Error")
    BoolArgument1 = Array("Processor Number", "Form Factor Category", "OEM Brand", "2 in 1", "Chromebook")
    BoolArgument2 = Array("CPU Check", "FF Check", "OEM Check", "2in1 Check", "Chrome Check")
    
    ' 处理前5个对比列
    For i = 0 To 4
        ' 新增表格列并设置表头
        With tbl.ListColumns.Add(Position:=tbl.ListColumns.Count + 1)
            .Name = BoolName(i)
            ' 写入对比公式
            .DataBodyRange.FormulaR1C1 = "=[@[" & BoolArgument1(i) & "]]=[@[" & BoolArgument2(i) & "]]"
            ' 设置单元格背景（可选，对齐XCheckColumnData的格式）
            .Range.Interior.ThemeColor = xlThemeColorDark1
            .Range.Interior.TintAndShade = -0.149998474074526
        End With
    Next i
    
    ' 处理Row Error列
    With tbl.ListColumns.Add(Position:=tbl.ListColumns.Count + 1)
        .Name = BoolName(5)
        .DataBodyRange.Formula = "=AND(" & tbl.ListColumns(BoolName(0)).Range.Offset(1, 0).Address(False, False) & ":" & tbl.ListColumns(BoolName(4)).Range.Offset(1, 0).Address(False, False) & ")"
    End With
End Sub

方案2：改用A1样式公式（若不需要新增表格列） #

如果目标单元格不在Table1范围内，无法使用结构化引用，改用普通单元格引用替代：

' 替换XGetScore中报错的代码段
If i < 5 Then
    ActiveCell.Formula = _
        "=" & ws.Range("Table1[" & BoolArgument1(i) & "]").Offset(0, 0).Address(False, False) & _
        "=" & ws.Range("Table1[" & BoolArgument2(i) & "]").Offset(0, 0).Address(False, False)
ElseIf i = 5 Then
    ws.Range("AX2").Formula = "=AND(AS2:AW2)"
End If

额外优化建议 #

1. 彻底移除所有Select和ActiveCell操作，直接通过对象引用（ws.Range、tbl.ListColumns）操作单元格，提升代码稳定性和执行效率。
2. 检查XCheckColumnData中插入列后，Table1是否自动扩展包含新插入的列，确保BoolArgument2中的列名确实存在于Table1中。
3. 循环时严格匹配数组边界，避免冗余的无效循环。

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