У нас в лаборатории возникла необходимость регистрации точного времени поступления проб и выдачи результатов анализов. Чтобы как то облегчить работу лаборантов решил сделать так, чтобы дата и время автоматически заносились в соответствующий столбец. Порылся я в интернете, попросил помощи у людей и мне подсказали как это можно сделать. В итоге у меня получилось автоматически заносить дату и время поступления проб в 1 столбец, но вот автоматически заносить время выдачи результатов не получается. Да, для облегчения ввода фамилии сделал в виде выпадающего списка. Может это мешает работе макроса. Сразу хочу предупредить, что в макросах мало что понимаю и подозреваю, что 2 макроса не могут последовательно работать. Читал что их нужно как то объединять, но могу сообразить как именно. У кого будет время и желание посмотрите пожалуйста. Заранее всем спасибо.
Здравствуйте!
У нас в лаборатории возникла необходимость регистрации точного времени поступления проб и выдачи результатов анализов. Чтобы как то облегчить работу лаборантов решил сделать так, чтобы дата и время автоматически заносились в соответствующий столбец. Порылся я в интернете, попросил помощи у людей и мне подсказали как это можно сделать. В итоге у меня получилось автоматически заносить дату и время поступления проб в 1 столбец, но вот автоматически заносить время выдачи результатов не получается. Да, для облегчения ввода фамилии сделал в виде выпадающего списка. Может это мешает работе макроса. Сразу хочу предупредить, что в макросах мало что понимаю и подозреваю, что 2 макроса не могут последовательно работать. Читал что их нужно как то объединять, но могу сообразить как именно. У кого будет время и желание посмотрите пожалуйста. Заранее всем спасибо.Restiv
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Select Case False Case Intersect(Target, Range("B4:C200")) Is Nothing With Cells(Target.Row, "A") If IsEmpty(.Cells) Then .Value = Now() End With Case Intersect(Target, Range("L4:L200")) Is Nothing With Cells(Target.Row, "M") If IsEmpty(.Cells) Then .Value = Now() End With End Select With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
[/vba]
Здравствуйте так нужно? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Select Case False Case Intersect(Target, Range("B4:C200")) Is Nothing With Cells(Target.Row, "A") If IsEmpty(.Cells) Then .Value = Now() End With Case Intersect(Target, Range("L4:L200")) Is Nothing With Cells(Target.Row, "M") If IsEmpty(.Cells) Then .Value = Now() End With End Select With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
