Автоматическое добавление даты в ячейку Excel при изменении другой ячейки

Пример использования VBA

Рубрика «Вопрос-Ответ», «Помощь подписчикам», «Ответы на вопросы подписчиков».

Подписчик задал вопрос: как сделать, чтобы в ячейку Excel автоматически вставлялась текущая дата, при вводе какого-нибудь значения в другую ячейку? После этого дата должна остаться фиксированной. То есть нужно сделать так, чтобы она больше не менялась.

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

Как я реализовал автоматическое добавление даты в Excel при изменении ячейки

Поставленную задачу мы будем решать с помощью VBA.

Первое что нам нужно сделать – создать условие: если ячейка A1 не пустая, то записать в ячейку B1 текущую дату.

Код VBA будет выглядеть так:

If Range("A1") <> "" And ActiveSheet.ProtectContents = False Then
Range("B1") = Date 'Если ячейка A1 не пустая, то вставляем в ячейку B1 текущую дату

Всё хорошо. Только дата не помещается в нашу ячейку и из-за этого мы видим вместо цифр решётки. Нужно увеличить ширину второго столбца, чтобы всё корректно отображалось.

Cells(1, 2).EntireColumn.AutoFit 'автоподбор ширины ячейки B1

После этого ставим запрет на изменение ячейки B1.

Cells.Locked = False 'сначала снимаем защиту с ячеек (так надо сделать)
Range("B1").Locked = True 'задаём параметр (защищаемая ячейка) для ячейки B1
ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True 'защищаем лист

 Но это ещё не всё. Код вроде бы работает. Но если мы один раз запустили макрос и он сработал, то есть дата была вставлена в ячейку B1 и лист стал защищённым, то при любом последующем запуске макроса будет возникать ошибка. Поэтому нужно поставить проверку на то защищён лист от редактирования, или нет. Доделаем первую строку нашего кода.

If Range("A1") <> "" And ActiveSheet.ProtectContents = False Then
Range("B1") = Date 'Если ячейка A1 не пустая и лист не защищён, то вставляем в ячейку B1 текущую дату

Весь код выглядит так:

Sub Макрос1()
'
' Макрос1 Макрос
'

If Range("A1") <> "" And ActiveSheet.ProtectContents = False Then
Range("B1") = Date 'Если ячейка A1 не пустая и лист не защищён, то вставляем в ячейку B1 текущую дату
Cells(1, 2).EntireColumn.AutoFit 'автоподбор ширины ячейки B1
Cells.Locked = False 'сначала снимаем защиту с ячеек
Range("B1").Locked = True 'задаём параметр (защищаемая ячейка) для ячейки B1
ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True 'защищаем лист
End If
End Sub

Ну и поскольку перед нами стояла задача, чтобы всё было автоматически, то скорее всего нужно сделать чтобы макрос сам запускался тогда когда меняется значение ячейки A1. Для этого я просто создал событие Change для рабочего листа и прописал для него следующий код:

Private Sub Worksheet_Change(ByVal Target As Range)
'проверяем, произошли изменения в ячейке A1, или нет
   If Target.Count = 1 And Target.Row = 1 And Target.Column = 1 Then

      'если в ячейке А1 произошли изменения, то выполняем нужное нам действие (запускаем Макрос1)
   
      Макрос1

   End If
End Sub

Видео по теме

АВТОРИЗАЦИЯ