Здравствуйте, форумчане. Подскажите пожалуйста как сделать... http://www.planetaexcel.ru/techniques/6/44/ Как в этом макросе сделать так, чтобы при вводе значения в ячейку дата вставлялась в одну ячейку (как например в этом макросе - в следующую справа), а при удалении значения из этой же ячйеки (del) в другую. (например через одну вправо).
Код
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
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
If Target.Value = "" Then
With cell.Offset(0, 2)
.Value = Now
.EntireColumn.AutoFit
End With
End If
End If
Next cell
End Sub
Попробовал, не совсем то, при вставке вставляется, но и при удалении вставляется дата в (0,1) надо чтобы только при вводе вставлялось в (0,1) а при удалении только (0,2) можно так?
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
If Target.Value <> "" Then
With cell.Offset(0, 1) 'вводим в соседнюю справа ячейку дату
.Value = Now
.EntireColumn.AutoFit 'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
End With
Else
With cell.Offset(0, 2)
.Value = Now
.EntireColumn.AutoFit
End With
End If
End If
Next cell
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target
If Not Intersect(cell, Range("A2:A100")) Is Nothing Then
Application.EnableEvents = False
With cell.Offset(0, Switch(Target.Value = "", 2, Target.Value <> "", 1))
.Value = Now
.EntireColumn.AutoFit
End With
cell.Offset(0, Switch(Target.Value = "", 1, Target.Value <> "", 2)).Value = Empty
Application.EnableEvents = True
End If
Next cell
End Sub