Нужна помощь в блокировке выбранного диапазона ячеек с помощью VBA

Question

Мне нужна помощь в блокировке определенного диапазона ячеек на основе выбора значения из списка из другой ячейки.

Чтобы быть конкретным, я создал список проверки данных для столбцов с N5 по N36, после выбора значения «Exist» из ячейки N5, я хочу заблокировать эту определенную строку от O5 до U5.

i.e «Exist» в N6 блокирует O6 до U6 и так далее.

Аналогичным образом для других рядов до N36.

И если пользователь выбирает «Не существует», я бы хотел, чтобы эти ячейки оставались разблокированными и редактируемыми, аналогичными приведенному выше условию.

Я пробовал макросы с разных форумов, используя самые простые знания об использовании макросов, но большинство из них блокирует весь лист.

код Я попробовал:

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

Это то, что вы пытаетесь (испытанный)? Также см. THIS. Это стоит прочитать.

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