Автоматическая вставка текущей даты в ячейку при вводе данных

Предположим, у нас имеется таблица заказов, куда пользователь вводит номер заказа, имя клиента, сумму и т.д. Необходимо сделать так, чтобы при внесении номера заказа в столбец А - в столбце B напротив введенного заказа автоматически появлялись дата и время его занесения:

date_auto_enter3.png

Чтобы реализовать такой ввод даты, нам потребуется простой макрос, который надо добавить в модуль рабочего листа. Для этого щелкните правой кнопкой мыши по ярлычку листа с таблицей и выберите в контекстном меню команду Исходный текст (View code).

В открывшееся окно редактора Visual Basic скопируйте этот текст этого макроса:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A2:A100")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
               .Value = Now
               .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
    Next cell
End Sub

При необходимости измените "чувствительный" диапазон "А2:А100" на свой собственный. Если необходимо вставлять дату не в соседний столбец, а правее - подставьте в оператор Offset(0,1) вместо 1 число побольше.

Закройте редактор Visual Basic и попробуйте ввести что-нибудь в диапазон А2:А100. В соседней ячейке тут же появится текущая дата-время!

Ссылки по теме

 



Страницы: 1  2  3  4  5  
СердЖиГ
06.10.2012 16:53:48
Макрос очень полезный, особенно когда нужно проконтролировать дату/время внесения информации. Правда обнаружил, что дата вставляется при любом изменении в ячейке, в том числе и при Delete. Возможно ли это как-то исправить?
СердЖиГ
06.10.2012 16:54:49
Можно так:
If IsEmpty(Target) Then
     Target(1, 2) = Empty
Else
     With Target(1, 2)
        .Value = Now
        .EntireColumn.AutoFit
     End With
End If
27.12.2013 10:04:50
Добрый день.
А куда именно в макросе приведенном выше нужно вставить Ваш код, чтобы он работал?
Спасибо.
28.12.2013 11:06:29
Александр, вставьте вместо 5,6,7 строчек.
17.06.2014 17:15:33
Николай, никак не получилось данным методом:(
Не могли бы Вы, для не особо одаренных, подсказать что поменять, чтобы при удалении ячейки из диапазона A2:A100 не выводилась дата в соседней ячейке. Просто время от времени нужно чистить таблицу...
10.07.2014 10:47:37
Добрый день, Николай. Подскажите, как в этом макросе:

Private Sub Worksheet_Change(ByVal Target As Range)
   
   For Each cell In Target   'проходим по всем измененным ячейкам
If Not Intersect(cell, Range("A2:A100")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
With cell.Offset(0, 1)   'вводим в соседнюю справа ячейку дату
  .Value = Now
  .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
End If
   Next cell
End Sub


переписать для 2 или нескольких разных столбцов
27.11.2016 18:50:51
Добрый день.
А куда именно в макросе приведенном выше нужно вставить Ваш код, чтобы он работал?
Спасибо.
ДЕЙСТВИТЕЛЬНО НЕ ПОНЯТНО. я уже раз 100 пробовал

Private Sub Worksheet_Change(ByVal Target As Range)
     
    For Each cell In Target   'ïðîõîäèì ïî âñåì èçìåíåííûì ÿ÷åéêàì
       If Not Intersect(cell, Range("c2:c100")) Is Nothing Then  'åñëè èçìåíåíåííàÿ ÿ÷åéêà ïîïàäàåò â äèàïàçîí A2:A100
            With cell.Offset(0, -1)        'ââîäèì â ñîñåäíþþ ñïðàâà ÿ÷åéêó äàòó
               If IsEmpty(Target) Then
     Target(0, -1) = Empty
Else
     With Target(0, -1)
        .Value = Now
        .EntireColumn.AutoFit
     End With
End If
       End If
    Next cell
End Sub
19.02.2014 09:53:25
Почему при удалении строки появляется дата?
27.11.2016 18:52:45
вы решили вопрос с датой, чтоб при удалении не появлялась дата. если да сбросьте код пожалуйста
06.11.2018 00:11:37
Напишу, как у меня получилось.



Private Sub Worksheet_Change(ByVal Target As Range)
    
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A3:A1000")) Is Nothing Then 'если изменененная ячейка попадает в диапазон A2:A1000
        If IsEmpty(Target) Then 'проверяем на удаление информации
            Target(1, 3) = Empty 'усли пусто - тогда очистить дату
            Else ' иначе
                With Target(1, 3) 'в ячейку с указанным смещением
                .Value = Date 'ввести дату
                .EntireColumn.AutoFit
                End With
            End If
       End If
    Next cell 'к следующей ячейке
End Sub
27.11.2016 16:09:03
Действительно не понятно куда вставлять этот код, чтоб при удалении он не заполнял даты опять. Можете если не сложно написать полный код, с условием что он не будет вставлять дату при удалении данных
Alfarg
06.10.2012 17:06:04
Как сделать чтобы не вставлялось текущее время тоесть всегда только дата
Заранее благодарен
06.10.2012 17:38:41
Замените Now на Date
03.10.2013 19:04:17
А еще можно просто формат ячеек-число-дата. И в ячейке будет показываться только дата)
Роман
06.10.2012 17:07:57
День добрый! макрос класс!, но почему то после закрытия книги и сохранения, при новом заходе макрос перестает работать.
06.10.2012 17:40:42
Проверьте, не включена ли у вас защита от макросов. В Excel 2003 и старше - Сервис - Макрос - Безопасность - Низкий. В Excel 2007 и новее - Файл - Параметры - Центр управления безопасностью - Макросы
Роки Санта Круз
06.10.2012 17:09:35
Добрый день! Спасибо огромное, лучшего сайта по Эксель не видел!
korsar34
06.10.2012 17:13:08
у меня вопрос:
как отредактировать макрос таким образом, чтобы дата ставилась только в одну конкретную ячейку?
т.е. смысл в чём:
есть табличка, люди туда заносят данные (причём под данными должно подразумеваться в том числе простое изменение цвета самой ячейки а она может просто быть пустая), и при закрытии таблицы либо при её сохранении в определённое место должна вноситься дата последнего изминения данной таблицы..
22.02.2013 12:24:07
Подскажите, пожалуйста, как сделать так чтобы дата изменений в диапазоне А2:N1000 вставлялись в соответствующую строку колонки O? Спасибо!
23.02.2013 12:51:36
Можно вот так:
Private Sub Worksheet_Change(ByVal Target As Range)   
    For Each cell in Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A2:N1000")) Is Nothing Then  
            With Range("O" & cell.row)
               .Value = Now
               .EntireColumn.AutoFit  
            End With
       End If
    Next cell
End Sub
25.02.2013 13:04:00
Спасибо огромное, очень помогли :)
Замечательный сайт!
23.02.2013 19:16:14
Доброго времени суток! Благодарю Вас за прекрасный сайт!!!! Очень помог мне во многом :). Подскажите, пожалуйста, когда я копирую Ваш текст в редактор Visual Basic, нужно ли потом как то сохранить чтобы заработало? И у меня почему то выделяет слово Sub красным цветом и макрос не работает.
28.02.2013 10:00:52
Ничего специально сохранять не нужно. Возможно, при копировании что-то потерялось. Лучше скачайте мой пример в заголовке и посмотрите код там.
05.03.2013 15:21:53
Хотела использовать этот макрос, но возникла проблема - фильтрую данные протягиваю нужное значение в столбце А - дата меняется в столбце B не только в отфильтрованных данных, но и в скрытых. Можно ли изменить макрос так, чтобы он корректно работал в случае с использованием фильтров.
а как сделать что бы дата вводилась не в правую а в левую сторону?
22.03.2013 20:24:17
Написать -1 вместо 1 в операторе Offset(0, 1)
24.03.2013 10:06:21
Николай,здравствуйте! Огромное Вам спасибо за вашу работу и Ваш классный сайт, мне очень помогает в работе.
И вот работая над данной темой у себя в программе возник вопрос, не подскажите что нужно сделать чтоб работал макрос. В столбце A работает формула в таблице

=ЕСЛИОШИБКА(ВПР(ВПР(СТРОКА(A1);Таблица8;12;0);$E$2:$F$18;2;0);"")
 
,но она срабатывает только после выполнения функции ВПР, а я в соседнюю ячейку, т.е. в столбец В определила вставку с помощью данного макроса дату, но макрос срабатывает только в том случае если ввод в ячейку происходит в ручную, а не с помощью данной формулы. Пожалуйста подскажите почему не работает макрос самостоятельно. Ведь ячейка изменяет свое содержимое, а макрос молчит?
26.03.2013 22:13:13
Очень классная вещь, а как сделать чтоб ещё для одного диапазона выдавало дату и время? Очень нужно чтоб была дата начала ввода и дата окончания в одной строке.
30.03.2013 23:42:15
привет  всем очень интересует эта тема, есть пару вопросов по ней
1) после изменения кода, а именно меняю строку "О" на "С" , и при дальнейшее работе (вводе данных в столбец "А" перед тем как появится дата и время  весь лист дребежит как бы с пол секунды - почему то до смену столбца такого не было.
2) как добавить в макрос  помимо даты и времени  логин заполняющего ячейку , ссмысл в том что файл лежит на серваке, и доступный по локальной сети - и на нем меняет кто что хочет и когда захочет  
11.04.2013 07:59:46
1. Возможно, это работает пересчет формул, если у вас тяжелый файл. А что такое "О" на "С"?
2. Добавить в код после 8-й строки
cell.Offset(0,2)=Application.UserName
 
18.01.2014 13:35:38
Павел, при вставке cell.Offset(0,2)=Application.UserName  неправильно срабатывает макрос.при изменении какой либо одной ячейки,имя пользователя прописывается сразу много раз,в строчку,через 1 ячейку.
02.04.2013 08:41:45
Подскажите, пожалуйста, как можно сделать тоже самое, но только в LibreOffice Calc? в Excel получается легко, а в Libre - не могу сообразить...
02.04.2013 09:48:08
Никак. В Libre Office нет макросов на VBA.
02.04.2013 10:32:03
а может есть возможность другим способом сделать автоматический ввод времени? :oops:
11.04.2013 07:55:20
В Libre Office? Думаю, есть - там же есть встроенный JavaScript вместо VBA для аналога макросов.
06.04.2013 12:22:01
Николай, добрый день.
Пытаюсь запустить Ваш макрос, но выдает ошибку. А можно как-то связаться с Вами, чтобы выяснить в чем проблема? Если есть возможность, напишите мне в скайп. Спасибо!
11.04.2013 07:53:01
В скайпе я редко доступен. Лучше сюда или в почту. Мой макрос в скаченном примере выдает ошибку? Или ваш макрос написанный по мотивам моего? ;)
15.04.2013 17:27:59
Подскажите, пожалуйста, а как подправить чтобы, если определенная ячейка (A2, например) пустая в нее вставлялась текущая дата, и при необходимости ее можно было поправить на другую?
При очистке ячейки - вновь по умолчанию текущая дата
16.04.2013 18:32:50
Здравствуйте!
Реально помогли с этим макросом!
огромное спасибо и дай вам бог здоровья и шо бы у вас руки не болели!!!
подскажите пожалуйста у меня в этом макросе большой диапазон, и когда изменяешь данные в одной ячейке то комп начинает искать где сделали изменение и куда вставить значение. На это к сожалению уходит много времени.
И так внимание вопрос. Как сделать что бы этот макрос выполнялся только перед сохранением данной книги или перед ее закрытием?
Заранее благодарю!
17.04.2013 23:55:04
Чтобы не тормозило, можно просто отключить автоматический пересчет книги на время выполнения макроса, т.е. добавить Application.Calculation=xlManual между 5-й и 6-й строчками и Application.Calculation=xlAutomatic между 7-й и 8-й.
18.04.2013 10:51:24
Спасибо!
Забыл написать я ее уже стер и все нормально заработало!

Еще раз спасибо!
25.04.2013 20:16:54
Добрый вечер!
Воспользовалась приведенным Вами макросом отлично работает, спасибо!
Но столкнулась со следующей проблемой, у меня файл разделен на 2 части, первая доступна для редактирования одним людям, вторая часть - другим, не знаю, как это правильно называется делала с помощью функции "Allow Users to Edit Ranges", данная функция работает только при защите листа, но при включенной защите не работают макросы... можно ли как-то дополнить макрос, чтобы обойти защиту?
Заранее огромное спасибо!
01.05.2013 01:04:53
Да, конечно - можно временно отключать защиту перед внесением даты и потом включать обратно. Т.е. перед 6-й строкой написать
Activesheet.Unprotect Password:="123"

а после 7-й:
Activesheet.Protect Password:="123"
28.11.2015 17:52:05
увы, не работает
04.05.2013 14:26:01
Добрый день.
Спасибо за ваш сайт много у вас научился.
Но вот столкнулся с проблемой, ввел ваш макрос в свои таблицы, все было прекрасно, да тех пор пока я не растянул таблицу и тут вся таблица перевелась на сегодняшнюю дату.
Как сделать, что б этого не происходило.
За ранее спасибо.
Вот мой макрос.
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cell In Target   'проходим по всем измененным ячейкам
    If Not Intersect(cell, Range("B4:I120";)) Is Nothing Then
      With Range("A" & cell.Row)
         .Value = Date
         .EntireColumn.AutoFit
      End With
    End If
    Next cell
End Sub
07.05.2013 22:50:53
Что вы понимаете под фразой "растянул таблицу"? Если перетаскивание за правый нижний угол для изменения размера, то макрос будет считать измененными все ячейки в столбце - и обновит дату на текущую.
07.05.2013 15:25:42
Добрый день, Николай Павлов.
Спасибо за макрос.:)
Меня волнует один вопрос: Как сделать так, чтобы только при вводе слова "Исправлено" в ячейку - А3,  диапазона A2:A100 выводилась текущая дата и время в соседнюю ячейку - В3.
07.05.2013 22:54:00
Можно добавить условие на проверку вхождения слова "Исправлено" в изменяемой ячейке в 4-й строке макроса:

If Not Intersect(cell, Range("A2:A100")) Is Nothing And cell Like "Исправлено*" Then   
08.05.2013 07:49:38
Спасибо.
Теперь заработало.
А можно еще сделать так чтобы после удаления информации из ячейки в диапазоне А2:А100, появившийся текущая дата в соседней ячейке обратно удалилась.
08.05.2013 01:47:58
Доброго время суток.

Я имел в виду, что когда я за край таблицы тяну вниз для увеличения ячеек в таблице.

11.05.2013 11:47:58
а как сделать чтобы этот макрос реагировал не только на ручной ввод в строчку, но и на вставку из буфера, т.е. сценарий - человек вводит повторяющееся значение, и чтобы не вводить его N раз, копирует его, выделяет N строк, нажимает ctrl+v, в результате дата только в первой строчке.
26.05.2013 19:56:00
Private Sub Worksheet_Change(ByVal Target As Range)
У меня уже это есть на нужной странице. Выдает ошибку. Как можно сделать?
26.05.2013 21:28:22
Видимо у вас уже есть макрос обработки события изменения листа. Тогда вставьте код моего макроса (со 2-й до предпоследней строчки) между Private Sub и End Sub. Например, сразу перед End Sub.
27.05.2013 10:34:49
Здравствуйте, Николай
Макрос конечно уже есть и я пробовал вставлять как вы и говорили. Я про это знаю. Однако все равно пишет ошибку компиляции, подсвечивает "cell", сообщение : "Variable not defined"
Может прежний макрос неверно написан? хотя он работает как надо.
31.05.2013 20:34:27
А у вас в заголовке модуля оператор Option Explicit не прописан, часом?
31.05.2013 18:08:42
Добрый день, Николай. Спасибо Вам за макрос. Хочу спросить, как переделать этот макрос, чтобы он не менял дату если в ячейке уже есть другая дата? То есть у меня таблица учета звонков, когда оператор принимает звонок - он вносит информацию в ячейку C1, рядом в B1 отображается время и дата. Потом оператор хочет уточнить, изменить внесенную информацию и соответственно дата тоже меняется. Нужно как то запретить макросу работать в не пустых ячейках, либо сделать так, чтобы он реагировал только на не пустые ячейки. Как это сделать?
31.05.2013 20:56:03
См. первый комментарий.
31.05.2013 21:13:04
А можно расписать полностью как для тупых?)
31.05.2013 21:35:54
Private Sub Worksheet_Change(ByVal Target As Range)
        For Each cell in Target
         If Not Intersect(cell, Range("A2:A100")) Is Nothing And _
                                       Target.Offset(0,1)="" Then
                With Target.Offset(0, 1)
                    .Value = Now
                    .EntireColumn.AutoFit
                End With
       End If
    Next cell
End Sub
31.05.2013 22:00:23
Спасибо!
22.11.2013 14:54:43
У Добрый день!
У меня глупого, по чему-то программа выдает ошибку(закрашивается красным цветом) в строке .Value=Now
Как это исправить, подскажите, пожалуйста?
28.12.2013 11:04:42
Не видя вашего кода помочь нереально. Покажите код.
19.03.2014 03:43:06
Та же самая проблема, ввожу код

Private Sub Worksheet_Change(ByVal Target As Range)
        For Each cell in Target
         If Not Intersect(cell, Range("A2:A100")) Is Nothing And _
                                       Target.Offset(0,1)="" Then
                With Target.Offset(0, 1)
                    .Value = Now
                    .EntireColumn.AutoFit
                End With
       End If
    Next cell
End Sub
 

.Value = Now сразу подсвечивается красным. Несмотря на это всё равно закрываю окно с кодом, выходит предупреждающее  сообщение о баге. Ввожу в столбец А значение и выбрасывает обратно на код, где желтым выделено
Private Sub Worksheet_Change(ByVal Target As Range)
Николай помогите :)
Если для помощи нужно предоставить дополнительный код ошибки или что то в этом роде, скажите от куда его выдернуть :)
08.05.2014 16:57:10
У вас там между точкой и словом Value какой-то непечатаемый символ. Скопируйте в Word, посмотрите сами.
05.07.2015 08:57:49
Николай! непечатаемый символ у вас в коде который вы приводите. При копировании он переносится в наши книги)))


https://yadi.sk/i/ACRcPVzqhfsva


Интересно, что это за символ?  
03.04.2018 07:21:09
Сам долго ломал голову. в итоге такой код получился

 Private Sub Worksheet_Change(ByVal Target As Range)
        For Each cell In Target
         If Not Intersect(cell, Range("B2:B100")) Is Nothing And _
                                       Target.Offset(0, -1) = "" Then
                With Target.Offset(0, -1)
                    .Value = Now
                    .EntireColumn.AutoFit
                End With
       End If
    Next cell
End Sub
05.06.2013 12:50:24
А мне не хотелось добавлять лишний столбец с датой внесения изменений в таблицу, поэтому решил делать через проверку данных. Книга у меня используется многими пользователями на разных компьютерах, поэтому вставил туда еще и наименование компьютера, системное имя пользователя и т.п.

Вот функция:

Function iVal(iOper As String) 
' iOper - в моем случае ФИО сотрудника (может быть любое текстовое значение)
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = "Данные изменил:"
        .ErrorTitle = ""
        .InputMessage = "ФИО: " & iOper & Chr(10) & "Время: " & Time & Chr(10) & "Дата: " _
            & Date & Chr(10) & "Компьютер: " & Environ("COMPUTERNAME") & Chr(10) & "Пользователь: " _ 
      & Environ("USERNAME")
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = False
    End With
End Function
 
Страницы: 1  2  3  4  5  
Наверх