Добрый всем вечер! Есть вопрос как защитить ячейки после ввода данных! Нашёл макрос с похожей задачей но отредактировать навыков не хватает. Помогите пожалуйста. Необходимо запретить редактирование в столбиках: D, G, L, P после тога как в ячейки введут данные.
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim new_value Dim r As Range Select Case Sh.Name Case "Лист1" Set r = Application.Intersect(Target, Range("Лист1!$D:$D")) Case Else Set r = Nothing End Select If r Is Nothing Then Exit Sub If Target.Rows.Count * Target.Columns.Count > 1 Then Application.Undo Exit Sub End If new_value = Target.Value Application.EnableEvents = False Application.Undo If Len(Target.Value) = 0 Then Target.Value = new_value End If Application.EnableEvents = True End Sub
[/vba]
Добрый всем вечер! Есть вопрос как защитить ячейки после ввода данных! Нашёл макрос с похожей задачей но отредактировать навыков не хватает. Помогите пожалуйста. Необходимо запретить редактирование в столбиках: D, G, L, P после тога как в ячейки введут данные.
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim new_value Dim r As Range Select Case Sh.Name Case "Лист1" Set r = Application.Intersect(Target, Range("Лист1!$D:$D")) Case Else Set r = Nothing End Select If r Is Nothing Then Exit Sub If Target.Rows.Count * Target.Columns.Count > 1 Then Application.Undo Exit Sub End If new_value = Target.Value Application.EnableEvents = False Application.Undo If Len(Target.Value) = 0 Then Target.Value = new_value End If Application.EnableEvents = True End Sub
Без Вашего файла такой вариант в модуль листа [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d_ As Range, d0_ As Range Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then For Each d0_ In d_ If Not IsEmpty(d0_) Then d0_.Offset(1).Select Exit Sub End If Next d0_ End If End Sub
[/vba]
Чуть подправил
Без Вашего файла такой вариант в модуль листа [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d_ As Range, d0_ As Range Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then For Each d0_ In d_ If Not IsEmpty(d0_) Then d0_.Offset(1).Select Exit Sub End If Next d0_ End If End Sub
Спасибо за помощь Подходит и такой вариант . Очень порадовало, что ячейку не то что отредактировать, а и перейти не получается :haha: . Будет теперь моим коллегам развлечение.
Спасибо за помощь Подходит и такой вариант . Очень порадовало, что ячейку не то что отредактировать, а и перейти не получается :haha: . Будет теперь моим коллегам развлечение.inohodec
Доброе утро! А есть ещё какие то варианты защиты ячеек? На практике не совсем удобно перескакивание оказалось, а было таким прикольным! Добавил свой файл.
Доброе утро! А есть ещё какие то варианты защиты ячеек? На практике не совсем удобно перескакивание оказалось, а было таким прикольным! Добавил свой файл.inohodec
Перескакивать можно не обязательно на пустую ячейку ниже, можно еще куда-нибудь А еще вариант, например, такой (на основе выложенного Вами макроса) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then If d_.Count > 1 Then Application.Undo Exit Sub End If Application.EnableEvents = 0 Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End Sub
[/vba]
Перескакивать можно не обязательно на пустую ячейку ниже, можно еще куда-нибудь А еще вариант, например, такой (на основе выложенного Вами макроса) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then If d_.Count > 1 Then Application.Undo Exit Sub End If Application.EnableEvents = 0 Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End Sub
_Boroda_, подскажите решение моей проблемы на базе вашего макроса. Имеется куча листов, в которых имеются данные и формулы, которые не нужно менять никому, кроме "посвящённых". Можно просто поставить Защиту на листы и книгу, но это не сильно "красиво". Решил воспользоваться вашим макросом, но добавил в него 1 строчку: [vba]
Код
If Range("ZZ999").Value = 1 Then Exit Sub
[/vba] И изменил область запрета изменений: [vba]
Код
Set d_ = Intersect(Target, Range("A1:BA46"))
[/vba] Естественно, всё нормально отрабатывает. Как теперь это всё дело распространить на все листы, а их там около 20? Неужели в каждом модуле листа прописывать этот код? Или можно в модуле книги прописать этот код, но только расписать все возможные имена листов для областей запрета?
_Boroda_, подскажите решение моей проблемы на базе вашего макроса. Имеется куча листов, в которых имеются данные и формулы, которые не нужно менять никому, кроме "посвящённых". Можно просто поставить Защиту на листы и книгу, но это не сильно "красиво". Решил воспользоваться вашим макросом, но добавил в него 1 строчку: [vba]
Код
If Range("ZZ999").Value = 1 Then Exit Sub
[/vba] И изменил область запрета изменений: [vba]
Код
Set d_ = Intersect(Target, Range("A1:BA46"))
[/vba] Естественно, всё нормально отрабатывает. Как теперь это всё дело распространить на все листы, а их там около 20? Неужели в каждом модуле листа прописывать этот код? Или можно в модуле книги прописать этот код, но только расписать все возможные имена листов для областей запрета?Yurbas
В модуле книги есть событие изменение в диапазоне Target на листе Sh [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[/vba] На него вешаете. Кстати, так в самом первом макросе в этой теме сделано - на все листы Вот так получится [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Sh Dim d_ As Range Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then If d_.Count > 1 Then Application.Undo Exit Sub End If Application.EnableEvents = 0 Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End With End Sub
[/vba]
В модуле книги есть событие изменение в диапазоне Target на листе Sh [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[/vba] На него вешаете. Кстати, так в самом первом макросе в этой теме сделано - на все листы Вот так получится [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Sh Dim d_ As Range Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then If d_.Count > 1 Then Application.Undo Exit Sub End If Application.EnableEvents = 0 Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End With End Sub
_Boroda_, ещё проблема возникла: если в ячейку что-то пишу и жму Enter, то макрос прекрасно отрабатывает и возвращает в ячейку первоначальное значение. Но если просто встать на ячейку и нажать Delete, то Excel впадает в глубокую задумчивость (постоянно удаляет-восстанавливает предыдущее значение ячейки), а потом выдаёт сообщение о "переполнении стека"... Я так понял, что нужно написать обработку события BeforeDelete, то есть что-то написать для запрета этого самого Delete, но что там прописывать — затупил .
_Boroda_, ещё проблема возникла: если в ячейку что-то пишу и жму Enter, то макрос прекрасно отрабатывает и возвращает в ячейку первоначальное значение. Но если просто встать на ячейку и нажать Delete, то Excel впадает в глубокую задумчивость (постоянно удаляет-восстанавливает предыдущее значение ячейки), а потом выдаёт сообщение о "переполнении стека"... Я так понял, что нужно написать обработку события BeforeDelete, то есть что-то написать для запрета этого самого Delete, но что там прописывать — затупил .Yurbas
А вот если несколько ячеек выделить и Делит нажать, то тогда да Предлагаю так [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Sh Dim d_ As Range Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then Application.EnableEvents = 0 If d_.Count > 1 Then Application.Undo Application.EnableEvents = 1 Exit Sub End If Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End With End Sub
[/vba]
StoTisteg, очередной непроверенный пост? Что, религия не позволяет посмотреть, что предложенный вами макрос вообще не выполняет исходную задачу?
А вот если несколько ячеек выделить и Делит нажать, то тогда да Предлагаю так [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Sh Dim d_ As Range Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P")) If Not d_ Is Nothing Then Application.EnableEvents = 0 If d_.Count > 1 Then Application.Undo Application.EnableEvents = 1 Exit Sub End If Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End With End Sub
А при чём тут, простите, сказанное Yurbas'ом? Что конкретно он имел в виду, только он сам знает... А для описанного им эффекта именно на одной ячейке я тоже поводов не вижу.
А при чём тут, простите, сказанное Yurbas'ом? Что конкретно он имел в виду, только он сам знает... А для описанного им эффекта именно на одной ячейке я тоже поводов не вижу.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Так, не ругаемся :). Вот файлик. Открываем первый лист, в ячейку A30 вписываем "1": теперь можно всё спокойно править-редактировать-удалять (делетать). В эту же ячейку вписываем всё, что угодно, окромя единицы, или вообще там удаляем данные: теперь при написании чего-нибудь другого в ячейку, в которой уже что-то записано, и нажатии на Ввод возвращаются данные, записанные там ранее. Если же нажать на Delete, то Excel туда-сюда удаляет-возвращает данные в ячейке, а потом выскакивает ошибка "Out of stack space". Попробуйте это проделать в разных местах...
Так, не ругаемся :). Вот файлик. Открываем первый лист, в ячейку A30 вписываем "1": теперь можно всё спокойно править-редактировать-удалять (делетать). В эту же ячейку вписываем всё, что угодно, окромя единицы, или вообще там удаляем данные: теперь при написании чего-нибудь другого в ячейку, в которой уже что-то записано, и нажатии на Ввод возвращаются данные, записанные там ранее. Если же нажать на Delete, то Excel туда-сюда удаляет-возвращает данные в ячейке, а потом выскакивает ошибка "Out of stack space". Попробуйте это проделать в разных местах...Yurbas
где при этом находясь? Сколько ячеек выделено? Код из сообщения 13 пробовали? Для листа он вот такой будет [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range If Range("A30").Value = 1 Then Exit Sub Set d_ = Intersect(Target, Range("A1:BA29")) If Not d_ Is Nothing Then Application.EnableEvents = 0 If d_.Count > 1 Then Application.Undo Application.EnableEvents = 1 Exit Sub End If Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End Sub
где при этом находясь? Сколько ячеек выделено? Код из сообщения 13 пробовали? Для листа он вот такой будет [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range If Range("A30").Value = 1 Then Exit Sub Set d_ = Intersect(Target, Range("A1:BA29")) If Not d_ Is Nothing Then Application.EnableEvents = 0 If d_.Count > 1 Then Application.Undo Application.EnableEvents = 1 Exit Sub End If Application.Undo If IsEmpty(Target) Then Application.Undo End If Application.EnableEvents = 1 End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
. Очень порадовало, что ячейку не то что отредактировать, а и перейти не получается :haha: . Будет теперь моим коллегам развлечение.
.
