Excel VBA：合并单元格E2下拉框变更无法触发Weapons子程序问题

我有一个包含「Character Sheet」和「Combat」两个工作表的工作簿，Combat表的E2单元格（已合并E2:G2并居中）是从Character Sheet获取数据的下拉框。希望当下拉框值变更时，自动调用Weapons子程序填充下方数据。

手动通过按钮调用Weapons子程序正常，但尝试多种Worksheet_Change、Worksheet_Calculate事件代码均无法触发，无Debug输出。

尝试过的事件代码 #

无判断的Worksheet_Change #

Private Sub Worksheet_Change(ByVal Target as Range)
    
    Dim selectedCell As Range

    ' Store the currently selected cell
    Set selectedCell = Selection

        Application.EnableEvents = False
        Call Weapons
        Application.EnableEvents = True

    ' Reselect the previously selected cell
    selectedCell.Select
    
End Sub

针对E2判断的Worksheet_Change #

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("E2")) Is Nothing Then
        Debug.Print "Change in E2 detected"

        Dim selectedCell As Range
        Set selectedCell = Selection

        Application.EnableEvents = False
        Debug.Print "Calling Weapons"
        Call Weapons
        Application.EnableEvents = True

        selectedCell.Select
    End If
End Sub

基础Worksheet_Calculate #

Private Sub Worksheet_Calculate()
    Debug.Print "Calculate event triggered"

    Dim selectedCell As Range
    Set selectedCell = Selection

    Application.EnableEvents = False
    Debug.Print "Calling Weapons"
    Call Weapons
    Application.EnableEvents = True

    selectedCell.Select
End Sub

带值对比的Worksheet_Calculate #

Private Sub Worksheet_Calculate()
    Static oldVal As Variant
    Dim newVal As Variant

    newVal = Me.Range("E2").Value

    If newVal <> oldVal Then
        Debug.Print "Change in E2 detected"

        Dim selectedCell As Range
        Set selectedCell = Selection

        Application.EnableEvents = False
        Debug.Print "Calling Weapons"
        Call Weapons
        Application.EnableEvents = True

        selectedCell.Select
    End If

    oldVal = newVal
End Sub

Weapons子程序代码 #

Sub Weapons()
    
    ' Define worksheets so thing can get cross referential
    Dim CS As Worksheet
    Set CS = ThisWorkbook.Sheets("Character Sheet")
    
    Dim combat As Worksheet
    Set combat = ThisWorkbook.Sheets("Combat")
    
    ' Make a variable for to hit
    Dim TH As Integer
    
    ' Greatsword
    If combat.Range("E2") = "Greatsword" Then
        
        TH = CS.Range("E1") + CS.Range("C8")
        
        With combat
            .Range("E4").value = "2d6"
            .Range("F4").value = CS.Range("E1")
            .Range("G4").value = "Slashing"
            .Range("F3").value = TH
            .Range("G3").value = "To hit"
        End With
    
    ' Eldritch Blast
    ElseIf combat.Range("E2") = "Eldritch Blast" Then
    
        TH = CS.Range("C8") + CS.Range("E6")
        
        With combat
            .Range("E4").value = "2d10"
            .Range("F4").value = CS.Range("E6")
            .Range("G4").value = "Force"
            .Range("F3").value = TH
            .Range("G3").value = "To hit"
        End With
    
    End If
    
End Sub

核心问题分析 #

1. 合并单元格的Target匹配问题：E2是合并区域E2:G2，当修改值时，Target可能指向合并区域内的任意单元格，仅判断Target与E2的交集会失效；
2. 事件可能被意外禁用：如果之前的代码执行出错，Application.EnableEvents = False未被重置，会导致所有事件停止触发；
3. Calculate事件不适用：若E2是数据验证下拉框（直接选择值），不会触发Calculate事件，这类代码自然无效。

修正后的Worksheet_Change事件代码 #

将以下代码粘贴到Combat工作表的代码模块中（右键Combat工作表标签→查看代码）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 明确指定合并区域
    Dim mergedE2 As Range
    Set mergedE2 = Me.Range("E2:G2")
    
    ' 判断Target是否落在合并区域内
    If Not Intersect(Target, mergedE2) Is Nothing Then
        Debug.Print "E2合并区域值已变更"
        
        Dim originalSel As Range
        Set originalSel = Selection
        
        ' 错误处理：确保事件和选择状态被恢复
        On Error GoTo ResetState
        Application.EnableEvents = False
        
        Debug.Print "执行Weapons子程序"
        Weapons ' 直接调用子程序
        
ResetState:
        Application.EnableEvents = True
        originalSel.Select
        ' 若有错误，抛出以便调试
        If Err.Number <> 0 Then Err.Raise Err.Number
    End If
End Sub

关键修复步骤 #

1. 先恢复事件状态：打开VBA编辑器的立即窗口（Ctrl+G），输入Application.EnableEvents = True并回车，确保事件未被禁用；
2. 验证合并区域判断：代码中直接指定合并区域E2:G2，确保任何修改该区域的操作都能被捕获；
3. 添加错误处理：防止执行过程中出错导致事件被永久禁用。

优化后的Weapons子程序（可选） #

优化代码结构，增加可读性和扩展性：

Sub Weapons()
    Dim CS As Worksheet, combatWs As Worksheet
    Set CS = ThisWorkbook.Sheets("Character Sheet")
    Set combatWs = ThisWorkbook.Sheets("Combat")
    
    Dim TH As Integer
    Dim selectedWeapon As String
    selectedWeapon = combatWs.Range("E2").Value ' 合并单元格取左上角值即可
    
    With combatWs
        ' 公共内容提前设置
        .Range("G3").Value = "To hit"
        
        Select Case selectedWeapon
            Case "Greatsword"
                TH = CS.Range("E1").Value + CS.Range("C8").Value
                .Range("E4").Value = "2d6"
                .Range("F4").Value = CS.Range("E1").Value
                .Range("G4").Value = "Slashing"
                .Range("F3").Value = TH
            Case "Eldritch Blast"
                TH = CS.Range("C8").Value + CS.Range("E6").Value
                .Range("E4").Value = "2d10"
                .Range("F4").Value = CS.Range("E6").Value
                .Range("G4").Value = "Force"
                .Range("F3").Value = TH
            Case Else
                ' 可选：清空未匹配武器时的数据
                .Range("E3:G4").ClearContents
                Debug.Print "未匹配到指定武器：" & selectedWeapon
        End Select
    End With
End Sub

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