锁定解锁单元格后执行Range.Merge触发1004错误，求助排查

先帮你梳理下问题：你有一个工作表，需要根据C列单元格的值合并对应行的单元格，同时C列会根据B列的值动态锁定/解锁。目前锁定解锁功能正常，但执行Range(Cells(Target.Row, i), Cells(Target.Row + Target.Value - 1, i)).Merge时触发1004错误。

错误原因分析 #

结合你的代码和1004错误的常见场景，主要问题有这几个：

1. 工作表处于保护状态：处理C列修改的代码块没有先解除工作表保护——第一个处理B列的块在操作后重新保护了工作表，当用户修改C列时，工作表还是保护状态，默认不允许合并单元格操作，直接触发错误。
2. 未校验输入值的有效性：如果C列输入的不是数字，或者计算后的目标行号（Target.Row + Target.Value -1）超出了工作表的有效行数范围，合并操作会失败。
3. 未处理多单元格批量修改：如果用户一次性修改多个C列单元格，代码会因为循环合并逻辑混乱而出错。

修复后的代码 #

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim pass As String
    pass = "" ' 设置密码，留空则无密码保护
    
    ' 处理B列的锁定/解锁逻辑
    If Not Intersect(Target, Range("B14:B50")) Is Nothing And Sh.Name <> "Dane" Then
        If Target.Cells.Count > 1 Then Exit Sub
        
        ActiveSheet.Unprotect pass
        If Target.Value = "Unlocked" Then
            Target.Offset(0, 1).Locked = False
        Else
            Target.Offset(0, 1).Value = 0
            Target.Offset(0, 1).Locked = True
        End If
        ActiveSheet.Protect pass
    End If
    
    ' 处理C列的合并单元格逻辑
    If Not Intersect(Target, Range("C14:C50")) Is Nothing And Sh.Name <> "Dane" Then
        Dim i As Long
        Dim targetRow As Long
        Dim mergeRows As Long
        Dim lastValidRow As Long
        
        ' 处理多单元格修改的情况
        If Target.Cells.Count > 1 Then Exit Sub
        
        ' 校验输入是否为有效数字
        If Not IsNumeric(Target.Value) Then
            MsgBox "请输入有效的数字！", vbExclamation
            Exit Sub
        End If
        
        mergeRows = CLng(Target.Value)
        targetRow = Target.Row
        lastValidRow = targetRow + mergeRows - 1
        
        ' 校验合并后的行号是否超出工作表范围
        If lastValidRow > ActiveSheet.Rows.Count Then
            MsgBox "合并行数超出工作表有效范围！", vbExclamation
            Exit Sub
        End If
        
        Application.DisplayAlerts = False
        ActiveSheet.Unprotect pass ' 操作前先解锁工作表
        
        ' 先取消已有合并
        For i = 1 To 8 Step 1
            If i <> 6 And i <> 7 And Cells(targetRow, i).MergeCells Then
                Cells(targetRow, i).UnMerge
            End If
        Next i
        
        ' 执行合并操作
        If mergeRows > 0 Then
            For i = 1 To 8 Step 1
                If i <> 6 And i <> 7 Then
                    Range(Cells(targetRow, i), Cells(lastValidRow, i)).Merge
                End If
            Next i
        End If
        
        ActiveSheet.Protect pass ' 操作完成后重新保护工作表
        Application.DisplayAlerts = True
    End If
End Sub

关键修改点说明 #

• 添加工作表解锁/保护逻辑：在处理C列合并前先解除保护，操作完成后重新保护，确保合并操作能正常执行。
• 增加输入有效性校验：判断输入是否为数字，以及合并后的行号是否在工作表有效范围内，避免无效输入导致的错误。
• 处理多单元格修改：增加If Target.Cells.Count > 1 Then Exit Sub，避免批量修改时的逻辑混乱。
• 变量拆分：把Target.Row和Target.Value拆分为单独变量，让代码更清晰，也方便校验。

内容的提问来源于stack exchange，提问作者Filip Frątczak