Сделать ячейку активной / неактивной по условию

[Cluster]

Подскажите, плиз, чайнику, можно ли запретить править ячейку при выполнении условия в другой ячейке? Т.е. к примеру, чтобы в B1 можно было что-то вводить руками, если A1=1, и нельзя, если A1<>1.

[аналитика]

правой кнопкой по ярлыку листа - Исходный текст, сюда вставляешь это

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Не_трогать As Range
   
   If Range("A1") = 1 Then Exit Sub
   
   Set Не_трогать = Range("B1") 'здесь можно область задать

   If Not Intersect(Target, Не_трогать) Is Nothing Then
      MsgBox "Ай-яй-яй!!!" & vbCrLf & "В ячейку A1 поставь 1", vbCritical, "Не хулиганить!"
      
      Application.EnableEvents = False
      CommandBars("Standard").Controls("Отменить").Execute
      Application.EnableEvents = True
   End If
End Sub

[vikttur]

Встроенными инструментами.
Меню Данные-Проверка-Тип_данных-Другой-Формула
=A1=1

[Ofigetmojno]

Добрый день!
Подскажите пожалуйста, использовал код, предложенный выше, Подточил под свои нужды, все работатет:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Не_трогать As Range
If Range("G9") = "Почасовая" Then Exit Sub
Set Не_трогать = Range("D9:F9")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"

Application.EnableEvents = False
CommandBars("Standard").Controls("О тменить").Execute
Application.EnableEvents = True
End If
End Sub
НО. Мне нужно ввести второе условие. Попробовал сделать так:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Не_трогать As Range
If Range("G9") = "Почасовая" Then Exit Sub
Set Не_трогать = Range("D9:F9")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
ElseIf Range("G9") = "По километражу" Then Exit Sub
Set Не_трогать = Range("D10:F10")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: По километражу", vbCritical, "Тупим))))"
Application.EnableEvents = False
CommandBars("Standard").Controls("О тменить").Execute
Application.EnableEvents = True
End If
End Sub

Выскакивает ошибка: Block If without End If.

Подскажите, что можно придумать.

[Кардаган]

Сообщение от Ofigetmojno

If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
ElseIf Range("G9") = "По километражу" Then Exit Sub
[/FONT]

У Вас этот If не закрыт. Нужно так:

 If Not Intersect(Target, Не_трогать) Is Nothing Then
      MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
  ElseIf Range("G9") = "По километражу" Then Exit Sub
   End If

То есть вместе будет:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Не_трогать As Range
If Range("G9") = "Почасовая" Then Exit Sub
Set Не_трогать = Range("D9:F9")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
ElseIf Range("G9") = "По километражу" Then Exit Sub
End If
Set Не_трогать = Range("D10:F10")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: По километражу", vbCritical, "Тупим))))"
Application.EnableEvents = False
CommandBars("Standard").Controls("О тменить").Execute
Application.EnableEvents = True
End If
End Sub

[Ofigetmojno]

Огромное спасибо!

Ошибка пропала, но теперь новая беда: код не работает.
Вернее верхняя половина работает, а нижняя - нет.

Если выбираю в ячейке G9 "По километражу" и пытаюсь изменить значения в диапазоне D9:F9 - все прекрасно работает (выскакивает окошко).

Если же в ячейке G9 ставлю "Почасовая" и пытаюсь в диапазоне D10:F10 поменять значения, то все меняется, несмотря на условие...

[Кардаган]

Сообщение от Ofigetmojno

Если же в ячейке G9 ставлю "Почасовая" и пытаюсь в диапазоне D10:F10 поменять значения, то все меняется, несмотря на условие...

Тогда так:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Не_трогать As Range
If Range("G9") = "Почасовая" Then Exit Sub
Set Не_трогать = Range("D9:F9")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
ElseIf Range("G9") = "По километражу" Then GoTo Далее
End If
Далее:
If Range("G9") = "По километражу" Then Exit Sub
Set Не_трогать = Range("D10:F10")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: По километражу", vbCritical, "Тупим))))"
Application.EnableEvents = False
CommandBars("Standard").Controls("О тменить").Execute
Application.EnableEvents = True
End If
End Sub

[Ofigetmojno]

Неа.. Код, как и раньше, работает наполовину.

[Ofigetmojno]

Может быть эту задачу можно решить другим способом?

[Кардаган]

А попробуйте так:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Не_трогать As Range
If Range("G9") = "Почасовая" Then Exit Sub
Set Не_трогать = Range("D9:F9")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: Почасовая", vbCritical, "Тупим))))"
Else
If Range("G9") = "По километражу" Then Exit Sub
Set Не_трогать = Range("D10:F10")
If Not Intersect(Target, Не_трогать) Is Nothing Then
MsgBox "Выбери тип оплаты: По километражу", vbCritical, "Тупим))))"
Application.EnableEvents = False
CommandBars("Standard").Controls("О тменить").Execute
Application.EnableEvents = True
End If
End If
End Sub