Lost your password?


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

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

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

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, 3 870 скачиваний)

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


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

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

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 43 комментария
  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. И не надо дублировать свой вопрос в комментариях к нескольким статьям.

      • Рустам:

        Похоже, что переменные предложенного кода несколько отличаются от исходного. И в исходном коде отсутствует эта часть, которую предложено заменить. Час пытался разобраться, но моих знаний не хватает, а функция очень нужна. Могли бы Вы, пожалуйста, проверить Ваше сообщение?

        • Рустам, код уже переписывался с момента публикации, статье уже не один год, а комментарии достаточно старые. Хотя даже в этом виде та часть, которую надо заменить, прослеживается логически. По сути все, что надо - заменить объект примечания ссылкой на нужную ячейку. Сейчас этот блок выглядит так:

          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

          и замены должны быть соответствующие:

          On Error Resume Next
                  If Target.Offset(,1).Value = "" Then 'примечания еще нет - записываем информацию об изменениях
                      Target.Offset(,1).Value = CreateObject("wscript.network").UserName & ":" & Chr(10) & "было: " & vv & "; стало: " & v & "; Дата: " & Format(Now, "dd.mm.yy HH:MM")
                  Else 'уже есть примечание - дописываем информацию об изменениях
                      Target.Offset(,1).Value = Target.Offset(,1).Value & Chr(10) & CreateObject("wscript.network").UserName & ":" & Chr(10) & "было: " & vv & "; стало: " & v & "; Дата: " & Format(Now, "dd.mm.yy HH:MM")
                  End If
          • Рустам:

            Спасибо большое! Разобрался. Можете, пожалуйста еще подсказать, почему после того, как макрос выполняет команду, стандартное действие "отмена действия" [Ctrl + Z] - не работает?

          • Могу ответить - потому что это известное ограничение Excel при применении макросов. Предвидя следующий вопрос: Как отменить действия макроса

  2. Михаил:

    Здравствуйте. А если этот код интегрировать в общую гугл таблицу, можно ли добавить в примечание еще емаил того кто вносит изменения?
    Или допустим я знаю все емаилы , присвоить каждому конкретное имя и вставлять автоматически его ? Спасибо !

    • Михаил, если Вы можете интегрировать это в Google - то полагаю, что получить какие-то email тоже будет не самой большой проблемой. Но лично я в этом не помогу, т.к. не уверен, что в Google можно вообще отслеживать изменения и создавать примечания скриптами.

  3. Галина:

    Здравствуйте, Дмитрий!
    Очень помог Ваш скрипт! Спасибо!
    Но вот только в примечании, перед текстом добавляются 6 пробелов в строке, в первых двух ячейках и три пробела в следующих двух и опят 6 пробелов в завершающей, что смещает текст в примечании и неудобно читаемо, так как не работает автоформатирование.
    R2:V34"
    Подскажите, пожалуйста, что можно сделать?

  4. Ольга:

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

    • Ольга, думаю не получится. Для этого надо будет защищать лист, что наложит ограничения в том числе и на действия макросом. Можно, конечно, каждый раз при изменении снимать защиту с листа тем же макросом, потом устанавливать. Но это может сделать процесс изменения данных на листе достаточно неприятным. Получится что-то вроде этого:

      Private Sub Worksheet_Change(ByVal Target As Range)
          'отслеживаем изменения только в диапазоне "E14:E50" - т.е. только статус
          '(изменить адрес, если надо отслеживать другие ячейки)
          If Intersect(Target, Me.Range("E1:E50")) Is Nothing Then Exit Sub
          Dim oComment As Comment
          On Error Resume Next
          Me.Unprotect    'снимаем защиту с листа
          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
          Me.Protect      'возвращаем защиту листа
      End Sub

      Других вариантов нет. Чтобы побольше узнать про защиту и как разрешить при этой защите изменять ячейки: Защита листов и ячеек в MS Excel

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

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


Для оформления сообщений Вы можете использовать следующие тэги:
<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 Яндекс.Метрика
© 2024 Excel для всех   Войти