需要使用VBAlocking所选单元格区域的帮助

我需要帮助locking特定范围的单元格基于从另一个单元格列表中select的值。

具体来说，我已经创build了列N5到N36的数据validation列表，从单元格N5中select值“Exist”，我想locking该特定行O5到U5。

即N6中的“存在”会将O6locking到U6等等。

同样的其他行直到N36。

如果用户select“不存在”，那么我希望这些单元保持解锁和可编辑类似于上述条件。

我已经尝试了使用macros的基本知识从各种论坛macros，但大多数locking整个工作表。

我试过的代码：

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("N5:N36")) Is Nothing Then ActiveSheet.Unprotect If Target.Value = "Exist" Then Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = False Else Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = True End If End If ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub 

我真的很感激你的快速帮助。

提前致谢。

Answer 1

这是你正在尝试（ 试验和testing ）？ 另见这个 。 这是值得一读的。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim rw As Long Dim sPass As String '~~> Password sPass = "BlahBLah" On Error GoTo Whoa '~~> For excel 2003 use .Count instead of .CountLarge '~~> In case of multiple cells were changed If Target.Cells.CountLarge > 1 Then Exit Sub Application.EnableEvents = False If Not Intersect(Target, Range("N5:N36")) Is Nothing Then If UCase(Trim(Target.Value)) = "EXIST" Then rw = Target.Row With ActiveSheet .Unprotect sPass .Cells.Locked = False .Range("O" & rw & ":U" & rw).Locked = True .Protect Password:= sPass , DrawingObjects:=True, _ Contents:=True, Scenarios:=True End With End If End If Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub 

Answer 2

你可以做这样的事情：

 Sub LockCells() 'unprotect the sheet ActiveSheet.Unprotect 'unlock all cells Cells.Locked = False Cells.FormulaHidden = False Dim cell As Range 'find all cells that need to be locked For Each cell In Range("N5:N36") If cell = "Exist" Then Range("O" & cell.Row & ":U" & cell.Row).Locked = True Range("O" & cell.Row & ":U" & cell.Row).FormulaHidden = True End If Next cell 'protect the sheet ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub