Excel VBA Worksheet_Change报错：仅允许当日日期行输入并锁定已填单元格

我看了你的代码，出现运行时错误主要是几个细节没处理好，比如事件循环触发、多单元格操作的兼容问题，还有逻辑上的小瑕疵。咱们一步步来改：

原代码的核心问题 #

• 事件循环触发：当你在Worksheet_Change里修改Target.Value或者设置Target.Locked时，会再次触发这个事件，导致无限循环，直接抛出错误。
• 未处理多单元格操作：如果用户选中多个单元格粘贴数据，Target.Row只会取第一个单元格的行号，逻辑就乱了。
• 日期判断的严谨性：直接用Range("A" & i) = Date，如果A列单元格不是日期格式，会出现判断错误。
• 错误的终止语句：End会直接终止整个程序，应该用Exit Sub来退出当前事件过程。

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 禁用事件触发，避免循环
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 出错时恢复事件状态
    
    Dim cell As Range
    Dim targetRow As Long
    
    ' 遍历每个被修改的单元格（处理多单元格情况）
    For Each cell In Target
        targetRow = cell.Row
        
        ' 检查A列对应行是否为当日日期
        If IsDate(Range("A" & targetRow)) And Range("A" & targetRow).Value = Date Then
            ' 解锁工作表，锁定当前单元格
            ActiveSheet.Unprotect Password:="jayant1234"
            cell.Locked = True
            ActiveSheet.Protect Password:="jayant1234", UserInterfaceOnly:=True ' 保留VBA操作权限
        Else
            ' 清空非法输入并提示
            cell.ClearContents
            MsgBox "只能在当日日期对应的行输入数据！", vbExclamation, "输入限制"
        End If
    Next cell

Cleanup:
    ' 恢复事件触发，避免后续事件失效
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "运行出错：" & Err.Description, vbCritical
    End If
End Sub

关键改进点说明 #

• 禁用事件循环：开头设置Application.EnableEvents = False，结尾在错误处理块恢复，彻底避免修改单元格时重复触发事件。
• 支持多单元格操作：用For Each cell In Target遍历每个被修改的单元格，确保每个单元格都能正确判断。
• 严谨的日期判断：先通过IsDate确认A列单元格是日期格式，再和Date比较，避免非日期值导致的错误。
• 优化保护设置：添加UserInterfaceOnly:=True参数，这样后续VBA操作工作表时不需要反复解锁，只限制用户界面操作。
• 错误处理：用On Error GoTo Cleanup确保即使出错，事件触发状态也能恢复，不会影响后续操作。

额外注意事项 #

1. 确保你的工作表预先设置所有单元格为未锁定（右键单元格→设置单元格格式→保护→取消勾选“锁定”），然后再保护工作表。
2. 如果需要锁定整行而不是单个单元格，把cell.Locked = True改成Rows(targetRow).Locked = True即可。

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