Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматичекая вставка фиксированой даты
 
#1
13.05.2018 08:18:44
Допустим, при вводе данные в ячейку диапазана A2:A100, автоматическая появлялась в соответствующей ячейке диапазона B2:B100  фиксированная дата, при этом дата не должна меняться при последуюших изменениях в ячейках диапазона A2:A100, в том числе при удаление и вставки ячейки или строка, кроме случая редактирования в самом ячейке даты.
Изменено: Мамбет - 13.05.2018 08:19:30
 
 
 
#2
13.05.2018 09:03:48
В модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A100")) Is Nothing And Target.Count = 1 Then
    On Error Resume Next
    Application.EnableEvents = False
    Target.Offset(, 1) = Date
End If
Application.EnableEvents = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
13.05.2018 09:27:10
Цитата
Мамбет написал:
при этом дата не должна меняться при последуюших изменениях в ячейках диапазона A2:A100
Добавлю к Саненому коду
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
If Not Intersect(Target, Range("A2:A100")) Is Nothing And Target.Columns.Count = 1 Then
    On Error Resume Next
    Application.EnableEvents = False
    For Each x In Target.Offset(, 1)
      If IsEmpty(x) Then x.Value = Date
    Next
End If
Application.EnableEvents = True
End Sub
 
 
 
#4
13.05.2018 11:36:53
Доброе время суток.
Добавлю 5 копеек к коду AAF (массовая вставка данных в A99:A115, например)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pCell As Range, intersectRange As Range
Set intersectRange = Intersect(Target, Range("A2:A100"))
If Not intersectRange Is Nothing And Target.Columns.Count = 1 Then
    Application.EnableEvents = False
    For Each pCell In intersectRange.Offset(0, 1)
      If IsEmpty(pCell.Value) Then pCell.Value = Date
    Next
    Application.EnableEvents = True
End If
End Sub
 
 
 
#5
13.05.2018 11:38:35
Андрей VG, Дэк ведь уже :)
 
 
 
#6
13.05.2018 11:48:49
Цитата
AAF написал:
Дэк ведь уже
Что уже?
Копирую ваш код в модуль чистого листа, выделяю диапазон A99:A115 ввожу абракадабра и нажимаю Ctrl+Enter - вижу, что даты появились в диапазоне  B99:B115. А по условию
Цитата
Мамбет написал:
появлялась в соответствующей ячейке диапазона B2:B100
;)
 
 
 
#7
13.05.2018 11:59:00
Андрей VG, Эх, невнимательность...  :cry:
Тогда добавлю еще 5 коп.
Если на пустую ячейку в столбце "A" нажать Del или ячейка в столбце "A" пуста, то дата проставляться не будет.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, rng As Range
Set rng = Intersect(Target, Range("A2:A100"))
If Not rng Is Nothing And Target.Columns.Count = 1 Then
    On Error Resume Next
    Application.EnableEvents = False
    For Each x In rng
      If Not IsEmpty(x) Then If IsEmpty(x.Offset(, 1).Value) Then x.Offset(, 1).Value = Date
    Next
End If
Application.EnableEvents = True
End Sub
Изменено: AAF - 13.05.2018 12:12:55
 
 
 
#8
13.05.2018 13:44:55
Цитата
AAF написал:
еще 5 коп.
Спасибо.
+
 
 
 
#9
13.05.2018 16:36:25
Здраствуйте  Sanja, AAF  и Андрей  VG я пробовал ставить Ваши макросы, на всех случаях почему то выдает ошибку "Argument not optional". Я пробовал и копированием, и вводом с клавиатуры, результат одни и те же.
 
 
 
#10
13.05.2018 16:41:45
Код
Private Sub Worksheet_Change(ByVal Target As Range)

Это событие листа, т. е. эти макросы будут работать, если их скопировать в модуль листа, на котором его работа требуется, а не в стандартный модуль
Щелкаете два раза по листу и открывается модуль, в него и вставляете.
Изменено: AAF - 13.05.2018 16:45:14
 
 
 
#11
13.05.2018 19:41:42
У меня заработал макрос спасибо Вам! AAF, Sanja и Андрей VG дай Бог Вам здоровья, счастья и успех, я рад очень , сколько лет не смог решить эту проблему.
 
 
 
Страницы: 1
Наверх