如何用Excel VBA GOALSEEK实现单元格双向联动维持B10等于B11

实现双向联动的VBA代码 #

你当前使用的Worksheet_SelectionChange是选区切换触发事件，修改单元格数值时不会触发，要实现修改后自动联动，需改用Worksheet_Change事件，同时加入防递归逻辑避免Excel卡死，完整代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 错误处理，防止异常导致事件永久关闭
    On Error GoTo ErrHandler
    
    ' 只处理B33或B37的修改，其他单元格修改不响应
    If Intersect(Target, Me.Range("B33, B37")) Is Nothing Then Exit Sub
    If Target.CountLarge > 1 Then Exit Sub ' 多选批量修改不响应
    
    ' 关闭事件触发，防止修改单元格时递归调用本事件
    Application.EnableEvents = False
    
    Select Case Target.Address(0, 0)
        Case "B33"
            ' 修改了B33，调整B37保持B10=B11
            Me.Range("B10").GoalSeek Goal:=Me.Range("B11").Value, ChangingCell:=Me.Range("B37")
        Case "B37"
            ' 修改了B37，调整B33保持B10=B11
            Me.Range("B10").GoalSeek Goal:=Me.Range("B11").Value, ChangingCell:=Me.Range("B33")
    End Select
    
ErrHandler:
    ' 无论执行是否成功，都重新开启事件
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "联动计算出错：" & Err.Description, vbExclamation
End Sub

使用说明 #

• 代码需要放在对应工作表的代码模块中，不要放在普通模块
• 要求B10为包含计算公式的单元格，且计算逻辑和B33、B37直接关联，否则单变量求解无法正常运行
• 如果需要调整联动单元格，直接修改代码中对应的单元格地址即可

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