Страницы: 1
RSS
Автоматическая вставка дат при вводе и при удалении
 
Здравствуйте, форумчане. Подскажите пожалуйста как сделать... 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) можно так?
 
как вариант
Изменено: heso - 02.03.2017 06:10:25
 
СПАСИБО ОГРОМНОЕ)))
 
Сокращённый паразит на теле макроса heso:
Код
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
 
Цитата
k61 написал:
Сокращённый паразит на теле макроса heso:
Что значит сокращенный паразит?)
Вроде все работает хорошо без паразитов)
Изменено: Александр К - 02.03.2017 06:34:18
 
http://dic.academic.ru/dic.nsf/dic_synonims/167212/%D1%81%D0%BE%D0%BA%D1%80%D0%B0%D1%89­%D0%B5%D0%BD%...
:)
Страницы: 1
Наверх