Автоматическая вставка статической даты

[varikvn]

Здравствуйте уважаемые коллеги.
Разрабатываю журнал посещения студентами занятий, и столкнулся с задачей - что бы когда нужные поля были заполнены, в нужное мне поле записывалась текущая дата (что бы было понятно когда преподаватель заполнил журнал).

Сделал так:

=ЕСЛИ(И(K73<>"";K72<>"";K18<>"";K17 <>"");СЕГОДНЯ();"")

Проблема в том, что функция СЕГОДНЯ() - динамическая, и каждый раз обновляет дату.

Мне же нужно что бы автоматом подтягивалась текущая дата, записывалась в ячейку и не изменялась каждый день, а изменялась если
1. заполнены нужные поля
2. если какое-то из нужных мне полей было изменено.

Вариант с ручным вводом (по типу сочетания клавиш CTRL+; ) не подходит, т.к. преподаватели будут мухлевать и ставить какую-угодно дату

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

Как решить вопрос, не придумал

В приложенном файле даты записываются в ячейки: H74:T74

[китин]

На что хватило знаний

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H73:T73")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    If Target <> "" And Target.Offset(1, 0) = "" Then Target.Offset(1, 0) = Date
     
End If
If Not Intersect(Target, Range("H72:T72")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    If Target <> "" And Target.Offset(2, 0) = "" Then Target.Offset(2, 0) = Date
    If Target = "" And Target.Offset(2, 0) = "" Then Target.Offset(2, 0) = ""
End If


End Sub

[AlexM12]

У меня так получилось

Public x
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    x = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(72, col) <> "" And Cells(73, col) <> "" And x <> Target.Value Then
        Cells(74, col) = Date
    Else '???
        Cells(74, col) = "" '???
    End If
End Sub

Строки с вопросами удалить, если после очистки любой из 4-х ячеек, удалять дату не нужно.

[kuklp]

Игорь, я так понял, что дата нужна в одном месте, там где Сегодня():

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K17:K18,K72:K73")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Application.CountA(Range("K17:K18,K72:K73")) = 4 Then [d17] = Date
    End If
End Sub

[китин]

Пока для меня это сложно

[AlexM12]

Сергей,

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

даты записываются в ячейки: H74:T74

Я наверно Worksheet_SelectionChange сделал зря и без него будет работать.

[varikvn]

Как всегда, огромное спасибо AlexM12, китин, kuklp,
что не оставили мой вопрос без внимания!

[varikvn]

AlexM12, скажите, а если я в другом месте такого же рода правило захочу вставить (различие в том какие 4 ячейки проверяются, и куда вставлять "тек. дата"), что в коде мне нужно сделать? Я скопировал Ваш код, поменял интервалы на другие, и поменял переменную с Х на Y но оно не заработало...

Public x
Public y
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    x = Target.Value
End Sub
Private Sub Worksheet2_SelectionChange(ByVal Target As Range)
    If Intersect(Range("H17:T18,H76:T77"), Target) Is Nothing Then Exit Sub
    y = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(72, col) <> "" And Cells(73, col) <> "" And x <> Target.Value Then
        Cells(74, col) = Date
    Else '???
        Cells(74, col) = "" '???
    End If
End Sub
Private Sub Worksheet2_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H76:T77"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(76, col) <> "" And Cells(77, col) <> "" And y <> Target.Value Then
        Cells(75, col) = Date
    Else '???
        Cells(75, col) = "" '???
    End If
End Sub

[AlexM12]

Как писал выше скорее всего достаточно так

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(72, col) <> "" And Cells(73, col) <> "" Then
        Cells(74, col) = Date
    End If
End Sub

В строке If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit
Sub указан диапазон.
Если изменение значения произошло в ячейках вне указанного диапазона, то макрос не выполняется.
Этот же диапазон можно указать так "H17:T17,H18:T18,H72:T72,H73:T7 3" Возможно вам так будет понятнее, чтобы сделать изменение диапазонов.
Дата вставляется строкой кода Cells(74, col) = Date 74 строка, col - столбец, где изменялось значение.
Если не получается, приложите пример.

[varikvn]

выше приложил пример что я сделал:
1. Добавил переменную Y
2. Скопировал обе функции, и изменил в них:
1 Название функций
2 Диапазоны значений
3 Назначение куда писать даты - было 74 стало 75