[英]Lock a cell if the adjacent cell is empty - Excel VBA
What I want to get is that if a cell in the range "D4: D14" is empty, the adjacent cell is locked. 我想要得到的是,如果“ D4:D14”范围内的单元格为空,则相邻单元格将被锁定。 My code is the following but it doesn´t work: 我的代码如下,但它不起作用:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("D4:D14"), Target)
If rng Is Nothing Then
Else
If IsEmpty(Target) Then
rng.Offset(0, 1).Locked = True
Else
rng.Offset(0, 1).Locked = False
End If
End If
End Sub
What I want to get is that if a cell in the range "D4: D14" is empty , the adjacent cell is locked . 我想要得到的是,如果“ D4:D14”范围内的单元格为空 ,则相邻单元格被锁定 。
In your code if the cell is empty you are setting the .Locked
property to False
whereas I guess you want the opposite? 在您的代码中,如果单元格为空, .Locked
属性设置为False
而我想您想要相反的设置吗?
This works for me 这对我有用
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Dim aCell As Range
Application.EnableEvents = False
If Not Intersect(Range("D4:D14"), Target) Is Nothing Then
ActiveSheet.Unprotect "MYPASSWORD" <~~ Change this to the actual password
For Each aCell In Range("D4:D14")
If Len(Trim(aCell.Value)) = 0 Then _
aCell.Offset(, 1).Locked = True Else _
aCell.Offset(, 1).Locked = False
Next
ActiveSheet.Protect "MYPASSWORD" <~~ Change this to the actual password
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Also ensure that the sheet is protected to see the effect of locked cells. 另外,请确保对工作表进行保护以查看锁定单元的效果。
EDIT 编辑
The title of the question says 问题标题说
Unlock a cell if the adjacent cell is empty - Excel VBA 如果相邻单元格为空,则解锁单元格-Excel VBA
In such a case 在这种情况下
If Len(Trim(aCell.Value)) = 0 Then _
aCell.Offset(, 1).Locked = True Else _
aCell.Offset(, 1).Locked = False
becomes 变
If Len(Trim(aCell.Value)) = 0 Then _
aCell.Offset(, 1).Locked = False Else _
aCell.Offset(, 1).Locked = True
NOTE: If the above code still doesn't work then type this in the Immediate window and press the enter key 注意:如果上面的代码仍然不起作用,请在“立即”窗口中键入此代码,然后按Enter键
Application.EnableEvents = True
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.