Автоматичне додавання дати в комірку 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

АВТОРИЗАЦІЯ