Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Создание макроса для записи истории изменений в столбце
 
Приветствую. Помогите, пожалуйста, решить задачку:
нужен макрос, который при изменении значений в столбце будет копировать строчку с этой ячейкой, где были изменения на другой лист, ставить дату изменения и разницу значений этой ячейки.

Например:
было:
бананы 10
кокосы 3


стало:
бананы 2
кокосы 7

макрос на следующем листе должен выдать:
дата (сегодня)
бананы -8
кокосы 4
Изменено: Yeti_magic - 11 Янв 2019 10:44:35
 
Добрый день. Чем помочь то?
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a&, mm, aa, zz As Range
If Target.Count > 1 Then Exit Sub
Set zz = Target
If Not Intersect(Columns(2), Target) Is Nothing Then
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    mm = .Calculation
    .Calculation = xlCalculationManual
    aa = Target.Value
    .Undo
    With Sheets(2)
      a = .UsedRange.Rows.Count
      If Len(.Cells(a, 1)) > 0 Then a = a + 1
      Target.EntireRow.Columns("A:B").Copy .Cells(a, 1)
      .Cells(a, 1).Offset(, 2) = Target.EntireRow.Columns(2) - aa
      .Cells(a, 1).Offset(, 3) = Environ("UserName")
      .Cells(a, 1).Offset(, 4) = Date
      .Cells(a, 1).Offset(, 5) = Time
      With .Range(.Cells(a, 1), .Cells(a, 6))
        .Borders.LineStyle = xlContinuous: .EntireColumn.AutoFit
      End With
    End With
    zz.Value = aa
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = mm
  End With
End If
End Sub
Изменено: Anchoret - 11 Янв 2019 14:09:41
 
Ой, а у меня почему-то наоборот считает... Или чего-то я глючу...  :)
Может, так?
Код
.Cells(a, 1).Offset(, 2) = -1 * (Target.EntireRow.Columns(2) - aa)
 
_Igor_61, так или иначе ТС эта тема видимо уже не интересна...
 
Спасибо большое!
Изменено: Yeti_magic - 14 Янв 2019 10:50:51
Страницы: 1
Читают тему (гостей: 1)
Наверх