Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

Запись изменений на листе в примечания

Иногда необходимо вести лог изменений в ячейках. Просто чтобы видеть как изменялась информация в ячейке. Например, это может пригодиться при ведении истории заказа, когда статус заказа записывается в одной ячейке. Сначала "В обработке", далее "Вывоз со склада", потом "Доставка" и т.п.
Приведенный ниже код создает примечание в ячейке, если её значение было изменено. В примечание заноситься информация о том, что было занесено в ячейку и когда это было занесено(т.е. дата и время изменения). Если примечание в ячейке уже есть, то в имеющееся примечание допишется информация об изменениях.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    'отслеживаем изменения только в диапазоне "E14:E50" - т.е. только статус
    '(изменить адрес, если надо отслеживать другие ячейки)
    If Intersect(Target, Me.Range("E14:E50")) Is Nothing Then Exit Sub
    Dim oComment As Comment
    On Error Resume Next
    Set oComment = Target.Comment
    If oComment Is Nothing Then
        Target.AddComment Target.Text & " " & Format(Now, "dd.mm.yy HH:MM")
    Else
        oComment.Text oComment.Text & Chr(10) & Target.Text & " " & Format(Now, "dd.mm.yy HH:MM")
    End If
End Sub

Код необходимо поместить в модуль листа(щелкнуть правой кнопкой мыши по ярлычку листа -Исходный текст), изменения на котором необходимо отследить. Подробнее о модулях.
Следует учитывать, что код сработает только если данные были изменены вручную и для одной ячейки, а не для нескольких. Если скопировать в вставить несколько ячеек, примечание будет создано только для одной, а текст примечания может отличаться от ожидаемого. Если изменения производятся посредством вычисления формул - код не сработает вообще.
Изменения отслеживаются исключительно для ячеек A17:I30. Чтобы изменить ячейки, в которых необходимо отслеживать изменения, необходимо в строке:
If Intersect(Target, Me.Range("E14:E50")) Is Nothing Then Exit Sub
заменить адрес "E14:E50" на адрес нужных ячеек.

Если необходимо, чтобы в примечание заносилось предыдущее значение ячейки и вдобавок необходимо ограничить диапазон отслеживания изменений конкретными ячейками, то можно применить следующий код:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v, vv, sf, sa As String
    'отслеживаем изменения только в диапазоне "A17:I30"(изменить адрес, если надо отслеживать другие ячейки)
    If Intersect(Target, Me.Range("A17:I30")) Is Nothing Then Exit Sub
    'если изменено более одной ячейки - завершаем выполнение во избежание ошибок
    If Target.Count > 1 Then Exit Sub
    'получаем новое значение
    v = Target.Value
    sf = Target.Formula
    'запоминаем адрес текущей выделенной ячейки
    'т.к. после Undo она изменится и надо будет вернуть
    sa = Selection.Address
    'получаем старое значение
    With Application
        .EnableEvents = 0
        .Undo
        vv = Target.Value 'старое значение
        'возвращаем последнее записанное значение
        Target.Formula = sf
        Me.Range(sa).Select
        .EnableEvents = 1
    End With
    'сравниваем новое значение с прежним
    If CStr(vv) <> CStr(v) Then
        'если значения различаются - создаем или дописываем примечание
        On Error Resume Next
        Dim oComment As Comment
        Set oComment = Target.Comment
        If oComment Is Nothing Then 'примечания еще нет - создаем и записываем информацию об изменениях
            Set oComment = Target.AddComment(CreateObject("wscript.network").UserName & ":" & Chr(10) & "было: " & vv & "; стало: " & v & "; Дата: " & Format(Now, "dd.mm.yy HH:MM"))
        Else 'уже есть примечание - дописываем информацию об изменениях
            oComment.Text oComment.Text & Chr(10) & CreateObject("wscript.network").UserName & ":" & Chr(10) & "было: " & vv & "; стало: " & v & "; Дата: " & Format(Now, "dd.mm.yy HH:MM")
        End If
        oComment.Shape.TextFrame.AutoSize = True
    End If
End Sub

Код так же как и предыдущий размещается в модуле листа(правая кнопка мыши по ярлычку листа -Исходный текст), изменения в котором необходимо отслеживать.
Так же в данном коде помимо старого значения в примечание так же записываемся имя пользователя, изменившего значение, новое значение, дата/время изменения. Изменения отслеживаются исключительно для ячеек A17:I30. Чтобы изменить ячейки, в которых необходимо отслеживать изменения, необходимо в строке:
If Intersect(Target, Me.Range("A17:I30")) Is Nothing Then Exit Sub
заменить адрес "A17:I30" на адрес нужных ячеек.
Хочу обратить внимание, что при изменении нескольких ячеек сразу код не будет выполняться, т.к. ячеек может быть много и их значения могут просто не уместиться в примечания. Если нужны отслеживания множества ячеек сразу, то имеет смысл ознакомиться со статьей: Ведение журнала сделанных в книге изменений

Скачать пример

  История изменений ячеек в примечаниях (72,5 KiB, 2 975 скачиваний)

Так же см.:
Ведение журнала сделанных в книге изменений
Выделение сделанных изменений


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 33 комментария
  1. Daulet:

    Добрый день!
    Скажите, можно ли сделать это немного иначе: изменения записывать не в примечания, а в одну из ячеек справа или слева?
    Например, изменения в ячейке A1 записываются в ячейку B1, изменения в ячейке A2 записываются в ячейку B2, изменения в ячейке A3 записываются в ячейку B3 и т.д. Это было бы намного практичнее в большинстве случаев, на мой взгляд.

    • Сделать можно. Вместо этого кода:

      Dim oComment As Comment
              On Error Resume Next
              Set oComment = Target.Comment
              If oComment Is Nothing Then
                  Set oComment = Target.AddComment(Application.UserName & ":" & Chr(10) & sValue & " " & Format(Now, "dd.mm.yy HH:MM"))
              Else
                  oComment.Text oComment.Text & Chr(10) & Application.UserName & ":" & Chr(10) & sValue & " " & Format(Now, "dd.mm.yy HH:MM")
              End If
              oComment.Shape.TextFrame.AutoSize = True

      запишите такой:

              On Error Resume Next
              If Target.Offset(,1).Value = "" Then
                  Target.Offset(,1).Value = Application.UserName & ":" & Chr(10) & sValue & " " & Format(Now, "dd.mm.yy HH:MM"))
              Else
                  Target.Offset(,1).Value = Target.Offset(,1).Value & Chr(10) & Application.UserName & ":" & Chr(10) & sValue & " " & Format(Now, "dd.mm.yy HH:MM")
              End If

      P.S. И не надо дублировать свой вопрос в комментариях к нескольким статьям.

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти