将数组监控列改为单单元格F3后Excel崩溃的VBA问题求助

背景 #

原代码功能是监控Sheet1（Dashboard）中动态变化的A6:A50区域，将该区域值存入数组；当区域内值变化时计算差值diff，并把差值及其他相关数据输出到Sheet2，监控该列重计算时运行正常。

需求与问题 #

需修改为监控Sheet1（Dashboard）的单个单元格F3，但修改后的代码直接导致Excel崩溃。

原代码问题点 #

1. 全局变量冲突：Module1中声明了全局Public myArr()，但PopulateBA过程又重复声明局部Dim myArr As Variant，导致全局变量未被正确赋值。
2. 数组与单个值混淆：单个单元格F3赋值给数组时，得到的是单个值而非数组，后续UBound(myArr)会触发错误。
3. 对象赋值错误：Set keyCells = Me.Range("F3").Value试图将单元格值（非Range对象）赋值给Range变量，直接触发类型错误。
4. 无效循环逻辑：保留了原多单元格区域的循环逻辑，单个单元格无需循环，循环会导致无意义的重复执行甚至死循环。
5. 类型不匹配：diff被声明为Range类型，但实际是数值计算结果，类型不匹配会引发错误。
6. 循环触发风险：Worksheet_Calculate中调用PopulateBA，恢复事件后会再次触发计算，形成循环调用导致Excel崩溃。

修复后的代码 #

1. Module1代码 #

Public myArr As Variant ' 改为Variant适配单个值/区域值
Public Sub PopulateBA()
    ' 直接给全局变量赋值，移除局部变量重复声明
    myArr = Sheet1.Range("F3").Value
End Sub

2. Sheet1（Dashboard）代码 #

Private Sub ToggleButton1_Click()

End Sub

Private Sub Worksheet_Calculate()
    Dim currentValue As Variant
    Dim diff As Double
    Dim NextRow As Long
    Dim ValueArray As Variant
    
    If Worksheets("Dashboard").ToggleButton1.Value = True Then
        On Error GoTo SafeExit
        ' 禁用事件与计算，防止循环触发
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        ' 获取当前F3的值
        currentValue = Me.Range("F3").Value
        
        ' 对比当前值与历史值（确保历史值已初始化）
        If Not IsEmpty(myArr) And currentValue <> myArr Then
            diff = currentValue - myArr
            
            ' 获取Sheet2的下一行
            NextRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1
            
            ' 构建输出数组（对应原代码i=1时的取值逻辑，即A3、B3等单元格）
            ValueArray = Array(Me.Cells(3, "A").Value, Me.Cells(3, "B").Value, diff, _
                              Me.Cells(3, "C").Value, Me.Cells(3, "D").Value, _
                              Me.Cells(3, "E").Value, Me.Cells(7, "F").Value, _
                              Me.Cells(3, "G").Value)
            
            ' 写入Sheet2
            Sheet2.Cells(NextRow, "A").Resize(, UBound(ValueArray) + 1).Value = ValueArray
        End If
        
        ' 更新历史值为当前值
        myArr = currentValue
    End If
    
SafeExit:
    ' 恢复Excel默认设置
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

3. ThisWorkbook代码（保留） #

Private Sub Workbook_Open()
    PopulateBA
End Sub

修复说明 #

• 修正全局变量的重复声明问题，确保历史值能被正确存储与读取。
• 移除针对多单元格的无效循环，直接对比单个单元格的当前值与历史值。
• 修正类型不匹配问题，将diff改为数值类型，移除错误的Range对象赋值逻辑。
• 取消Worksheet_Calculate中对PopulateBA的调用，改为直接更新全局变量，避免循环触发计算事件导致崩溃。
• 补全未声明的变量，避免隐式变量引发的未知错误。

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