如果单元格包含某些文本，则锁定相邻单元格

Posted 2023-04-13

【中文标题】如果单元格包含某些文本，则锁定相邻单元格

【英文标题】：Lock Adjacent cell if cell contains certain text

【发布时间】：2015-10-16 08:54:07

【问题描述】：

我正在尝试调整以下代码以在 M 列包含“NO”时锁定相邻单元格

例如如果 M12 包含“NO”，我想锁定“V12:AG12,AI12:AT12”

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim c As Range
Set rng1 = Intersect(Target, Range("M:M"))
If rng1 Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:="Password"

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

For Each c In rng1
    Select Case LCase(c.Value)
        Case Is = "YES"
        ActiveSheet.Unprotect Password:="Password"
        Cells(c.Row, 13).Resize(1, 12).Locked = False
        Range(Cells(c.Row, "V"), Cells(c.Row, "AG")).Locked = False
        Range(Cells(c.Row, "AI"), Cells(c.Row, "AT")).Locked = False
         ActiveSheet.Protect Password:="Password"
    Case Is = "NO"
        ActiveSheet.Unprotect Password:="Password"
        Range(Cells(c.Row, "V"), Cells(c.Row, "AG")).Locked = True
        Range(Cells(c.Row, "AI"), Cells(c.Row, "AT")).Locked = True
        ActiveSheet.Protect Password:="Password"
    Case Else
        ActiveSheet.Unprotect Password:="Password"
        MsgBox "Please only input YES or NO in this column", vbCritical +   vbOKOnly
        ActiveSheet.Protect Password:="Password"
        Exit Sub
End Select
Next c

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveSheet.Protect Password:="Password"
End Sub

但是我很困惑我会在上面的代码中插入条件“NO”，以及如何选择“锁定”的范围

附上一张图片来展示我想要实现的目标。

谢谢

【参考方案1】：

这应该是你想要的：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim c As Range
Set rng1 = Intersect(Target, Me.Range("M:M"))
If rng1 Is Nothing Then Exit Sub

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
Me.Unprotect Password:="Password"

For Each c In rng1
    Select Case LCase(c.Value)
        Case Is = "yes"
        Me.Cells(c.Row, 13).Resize(1, 12).Locked = False
        Me.Range(Me.Cells(c.Row, "V"), Me.Cells(c.Row, "AG")).Locked = False
        Me.Range(Me.Cells(c.Row, "AI"), Me.Cells(c.Row, "AT")).Locked = False
    Case Is = "no"
        Me.Range(Me.Cells(c.Row, "V"), Me.Cells(c.Row, "AG")).Locked = True
        Me.Range(Me.Cells(c.Row, "AI"), Me.Cells(c.Row, "AT")).Locked = True
    Case Else
        MsgBox "Please only input YES or NO in this column", vbCritical + vbOKOnly
        Exit Sub
End Select
Next c

Me.Protect Password:="Password"
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

请注意，我还添加了一些行来解锁将被“NO”锁定的单元格，这样如果您将值改回“YES”，它们就可以被解锁

【讨论】：

感谢您这么快看这个！非常感谢，锁定功能似乎不起作用我认为这与我的工作表受到保护有关我已经稍微修改了您的代码，但是当条件为“否”时它仍然无法锁定相邻的单元格请参阅修改后的代码（在原始问题中）..您对如何使其发挥作用有任何进一步的想法吗？

好的，我也添加了密码保护（不需要到处都放），由于这个模块是一个表单模块，你应该使用Me.而不是ActiveSheet.。还要注意您使用NO 和YES 进行测试的代码，但我们测试LCase(c) 所以它只会是小写。