Добрый день. Подскажите, пжлст: С помощью макроса [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target If Not Intersect(cell, Range("A2:A10000")) Is Nothing Then With cell.Offset(0, 1)
.Value = Now .EntireColumn.AutoFit End With End If
Next cell End Sub
[/vba]
задал условие, при заполнении ячеек в диапазоне А2:А10000 в соседних ячейках появлялись текущие дата и время. Вопросы:
1. При любом действии в ячейках А2:А10000, даже нажатии кнопки DEL в соседних ячейках появляются дата/время. Как этого избежать? 2. При изменении ранее внесенного значения в А2:А10000, естественно, в соседней ячейке дата/время обновляются на текущую. Можно ли сделать так: если я внес данные в диапазон А2:А10000 07.03.2017 в 10:48, то при изменении данных через, скажем, 4 дня, дата в соседней ячейке осталась 07.03.2017 в 10:48, а не изменилась на текущую? 3. Мне необходимы подобные условия в нескольких диапазонах одного листа. Как добавить условие внесения текущих даты/времени в соседнюю от заполняемой ячейки для еще нескольких диапазонов?
Спасибо
Добрый день. Подскажите, пжлст: С помощью макроса [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target If Not Intersect(cell, Range("A2:A10000")) Is Nothing Then With cell.Offset(0, 1)
.Value = Now .EntireColumn.AutoFit End With End If
Next cell End Sub
[/vba]
задал условие, при заполнении ячеек в диапазоне А2:А10000 в соседних ячейках появлялись текущие дата и время. Вопросы:
1. При любом действии в ячейках А2:А10000, даже нажатии кнопки DEL в соседних ячейках появляются дата/время. Как этого избежать? 2. При изменении ранее внесенного значения в А2:А10000, естественно, в соседней ячейке дата/время обновляются на текущую. Можно ли сделать так: если я внес данные в диапазон А2:А10000 07.03.2017 в 10:48, то при изменении данных через, скажем, 4 дня, дата в соседней ячейке осталась 07.03.2017 в 10:48, а не изменилась на текущую? 3. Мне необходимы подобные условия в нескольких диапазонах одного листа. Как добавить условие внесения текущих даты/времени в соседнюю от заполняемой ячейки для еще нескольких диапазонов?
aevgrafov, в первом Вашем сообщении код макроса, который вы выделили жирным, оформите соответствующими тегами. (поднимите на изменение сообщение, выделите текст кода и нажмите # на панели)
aevgrafov, в первом Вашем сообщении код макроса, который вы выделили жирным, оформите соответствующими тегами. (поднимите на изменение сообщение, выделите текст кода и нажмите # на панели)devilkurs
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A2:A10000")) Is Nothing Then If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Now End If End Sub
[/vba]
вдруг правильно [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A2:A10000")) Is Nothing Then If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Now End If End Sub
aevgrafov, 1) не срабатывает при очищении ячейки (DEL) 2) 345600 секунд - это 4 дня. Обновит дату если она не старше 4 дней 3) Range("A2:A10000", "C2:C10000") - дописываете через запятую нужные интервалы [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next For Each cell In Target If Not Intersect(cell, Range("A2:A10000", "C2:C10000")) Is Nothing And cell.Value <> "" Then With cell.Offset(0, 1)
If DateDiff("s", .Value, Now) <= 345600 Or .Value = "" Then Application.EnableEvents = False .Value = Now Application.EnableEvents = True .EntireColumn.AutoFit End If End With End If Next cell End Sub
[/vba]
aevgrafov, 1) не срабатывает при очищении ячейки (DEL) 2) 345600 секунд - это 4 дня. Обновит дату если она не старше 4 дней 3) Range("A2:A10000", "C2:C10000") - дописываете через запятую нужные интервалы [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next For Each cell In Target If Not Intersect(cell, Range("A2:A10000", "C2:C10000")) Is Nothing And cell.Value <> "" Then With cell.Offset(0, 1)
If DateDiff("s", .Value, Now) <= 345600 Or .Value = "" Then Application.EnableEvents = False .Value = Now Application.EnableEvents = True .EntireColumn.AutoFit End If End With End If Next cell End Sub