同一工作簿中运行修改后的Goal Seek宏失效问题求助

核心错误定位 #

• 未声明变量inputCells1：原代码声明了Dim inputCells As Range，但修改后赋值给的是inputCells1，该变量未被声明。若开启Option Explicit（强制变量声明）会直接触发编译错误；即便未开启，也可能引发变量类型异常。
• 事件循环隐患：GoalSeek执行时会修改单元格值，再次触发Worksheet_Change事件，可能导致无限循环，最终引发堆栈溢出。
• 命名范围有效性：需确认所有带1后缀的命名范围（如Zeta1、Thickness等）存在于目标工作表，且SetCell1、ToCell1、ChangeCell1单元格内是合法的单元格引用（如$A$1）。

修正后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim inputCells1 As Range ' 修正：声明对应变量
    Application.EnableEvents = False ' 禁用事件，避免循环触发
    
    On Error GoTo Cleanup ' 出错时自动恢复事件状态
    
    ' 列出输入单元格（移除重复的BiotTarget1）
    Set inputCells1 = Range("Zeta1, BiotTarget1, Thickness, kone, hone, SetCell1, ChangeCell1")
    
    If Not Application.Intersect(Target, inputCells1) Is Nothing Then
        With Me
            ' 先验证引用单元格非空
            If .Range("SetCell1").Value <> "" And .Range("ToCell1").Value <> "" And .Range("ChangeCell1").Value <> "" Then
                .Range(.Range("SetCell1").Value).GoalSeek _
                    Goal:=.Range(.Range("ToCell1").Value).Value, _
                    ChangingCell:=.Range(.Range("ChangeCell1").Value)
            End If
        End With
    End If

Cleanup:
    Application.EnableEvents = True ' 恢复事件状态
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbExclamation
    End If
End Sub

额外检查项 #

• 在VBA编辑器代码顶部添加Option Explicit（可通过「工具→选项→编辑器→勾选要求变量声明」开启），强制变量声明，避免同类错误。
• 按Ctrl+F3打开名称管理器，确认Zeta1、Thickness、kone、hone、BiotTarget1、SetCell1、ToCell1、ChangeCell1等名称存在且引用单元格正确。
• 确认SetCell1、ToCell1、ChangeCell1内的引用为合法地址，跨工作表引用需添加表名（如Sheet2!$A$1）。

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