基于其他单元格值的Excel自定义数据验证与单元格锁定需求

原脚本的核心问题 #

1. 事件选型错误：用Worksheet_SelectionChange（选中单元格触发）不符合需求，应该用Worksheet_Change（单元格内容修改时触发）——你的逻辑是R列输入内容后才要触发U列的变化，选中操作不相关。
2. 列范围不匹配：原脚本里用的是K2:K1000和G2:G1000，和你实际需要的R4:R1000、U4:U1000完全不符。
3. 整列判断逻辑错误：Range("G2:G1000").Value = "Open"是判断整列等于"Open"，不是对应行的单元格，逻辑完全错误。
4. 锁定/解锁范围错误：操作的是整列K2:K1000，不是对应行的U列单元格。

正确的VBA代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 限制只处理R4到R1000的单个单元格修改
    If Not Intersect(Target, Me.Range("R4:R1000")) Is Nothing And Target.Cells.Count = 1 Then
        Dim uCell As Range
        Set uCell = Me.Cells(Target.Row, "U") ' 获取对应行的U列单元格
        Dim ws As Worksheet
        Set ws = Me
        
        ' 取消工作表保护（如果有密码，在Unprotect后加密码参数，比如Unprotect "123"）
        ws.Unprotect
        
        On Error Resume Next ' 避免数据验证重复添加/删除报错
        Select Case UCase(Target.Value) ' 不区分大小写判断
            Case "OPEN"
                ' 解锁对应U列单元格
                uCell.Locked = False
                ' 添加Yes/No下拉列表验证
                uCell.Validation.Delete ' 先删除旧验证，避免冲突
                uCell.Validation.Add Type:=xlValidateList, _
                                    AlertStyle:=xlValidAlertStop, _
                                    Formula1:="Yes,No"
            Case "CLOSE"
                ' 锁定对应U列单元格，限制输入
                uCell.Locked = True
                ' 删除该单元格的验证规则
                uCell.Validation.Delete
                ' 光标移到对应行的V列
                Me.Cells(Target.Row, "V").Select
        End Select
        On Error GoTo 0 ' 恢复错误处理
        
        ' 重新保护工作表（如果有密码，在Protect后加密码参数，比如Protect "123"）
        ws.Protect UserInterfaceOnly:=True ' 这个参数能让VBA操作单元格时不用反复解锁
    End If
End Sub

关键说明 #

• UserInterfaceOnly:=True：设置这个参数后，工作表保护状态下VBA仍能修改单元格，不用每次操作都解锁/锁表，简化逻辑。
• UCase(Target.Value)：让判断不区分大小写，输入"open"或"Open"都能触发逻辑。
• 先删除旧验证：避免重复添加数据验证时抛出错误，用On Error Resume Next兜底异常。
• 限制单个单元格修改：防止批量粘贴R列内容时触发多次错误逻辑。

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