Запрет удаления содержимого нескольких ячеек в строке при установке значения в ячейке

@golan77 · Регистрация: 22.05.2015

Author24 — интернет-сервис помощи студентам

Добрый день
К сожалению не смог решить сам свою задачу, прошу помощи

Есть таблица excel с диапазоном A1:F10
Необходимо запретить удаление содержимого строки в диапазоне A1:E1 если в ячейке F1 установлено значение 1, а если не установлено то не запрещать.
Итак для каждой строки в таблице, т.е. проверять стоит ли значение 1 в ячейке F2, F3, F4...F10 и если да то запретить удаление содержимого строки в диапазоне A2:E2, A3:E3 и т.д., если нет разрешить.

Добавлено через 2 часа 54 минуты
Написал код для одного диапазона таблицы

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("F1") = 1 Then
         If Not Intersect(Range("A1:E1"), Target) Is Nothing Then
            Application.EnableEvents = False
                Application.Undo
                MsgBox "Изменение ячеек запрещено", vbCritical, "Нарушение процедуры"
            Application.EnableEvents = True
         End If
End If
End Sub

Подскажите как переделать код чтобы он работал для каждого следующего диапазона в строках таблицы

@k61 · 22.10.2015, 09:03

...

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1:e10]) Is Nothing Then Exit Sub
If Not IsEmpty(Target) Then Exit Sub
If Cells(Target.Row, 6) <> 1 Then Exit Sub
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End Sub

@~~Апострофф~~ · 22.10.2015, 09:04

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:E10"), Target) Is Nothing Then
  If Cells(Target.Row, 6) = 1 Then
    Application.EnableEvents = False
      Application.Undo
      MsgBox "Изменение ячеек запрещено", vbCritical, "Нарушение процедуры"
    Application.EnableEvents = True
  End If
End If
End Sub

@golan77 · 22.10.2015, 09:20 **[ТС]**

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1:e10]) Is Nothing Then Exit Sub
If Not IsEmpty(Target) Then Exit Sub
If Cells(Target.Row, 6) <> 1 Then Exit Sub
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End Sub

Спасибо за ответ, но к сожалению ваш код не работает если выделить сразу несколько ячеек, происходит удаление. Необходимо запретить удаление содержимого ячеек если сразу выделить несколько

Добавлено через 1 минуту

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:E10"), Target) Is Nothing Then
If Cells(Target.Row, 6) = 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "Изменение ячеек запрещено", vbCritical, "Нарушение процедуры"
Application.EnableEvents = True
End If
End If
End Sub

Спасибо, а возможно при этом сделать исключения для определенных столбцов в таблице?

@golan77 0 / 0 / 0 Регистрация: 22.05.2015 Сообщений: 2
	22.10.2015, 09:20 [ТС]	4
	Код Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [a1:e10]) Is Nothing Then Exit Sub If Not IsEmpty(Target) Then Exit Sub If Cells(Target.Row, 6) <> 1 Then Exit Sub With Application .EnableEvents = False .Undo .EnableEvents = True End With End Sub Спасибо за ответ, но к сожалению ваш код не работает если выделить сразу несколько ячеек, происходит удаление. Необходимо запретить удаление содержимого ячеек если сразу выделить несколько Добавлено через 1 минуту Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("A1:E10"), Target) Is Nothing Then If Cells(Target.Row, 6) = 1 Then Application.EnableEvents = False Application.Undo MsgBox "Изменение ячеек запрещено", vbCritical, "Нарушение процедуры" Application.EnableEvents = True End If End If End Sub Спасибо, а возможно при этом сделать исключения для определенных столбцов в таблице? 0

Запрет удаления содержимого нескольких ячеек в строке при установке значения в ячейке

Решение