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

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    'если изменили более одной ячейки - ничего не отслеживаем
    Dim lcnt As Long
    'игнорируем ошибки на случай, если выделено слишком много ячеек для помещения в Long
    On Error Resume Next
    lcnt = Target.Count
    If lcnt > 1 Then Exit Sub
    On Error GoTo 0
 
    Dim vOldVal, vNewVal, sSel As String
    With Application
        'отключаем отслеживание событий
        .EnableEvents = False
        .ScreenUpdating = False
        'запоминаем текущее выделение ячеек
        sSel = Selection.Address
        'запоминаем текущее значение
        vNewVal = Target.Formula
        'возвращаем предыдущее значение
        .Undo
        'запоминаем предыдущее значение
        vOldVal = Target.Formula
        'возвращаем текущее значение
        Target.Formula = vNewVal
        'если значение/формула изменились окрашиваем в красный цвет
        If vOldVal <> vNewVal Then
            Target.Interior.Color = vbRed
        End If
        'возвращаем прежнее выделение ячеек
        Me.Range(sSel).Select
        'возвращаем отслеживание событий
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Как это использовать. Щелкаем правой кнопкой мыши на ярлыке того листа, изменения в котором необходимо изменить -Исходный текст (View code) -Вставляем приведенный код. Подробнее про модули листа см.здесь.

Но приведенный код работает только в одном листе(том, в модуле которого размещен код). Если необходимо отследить изменения во всех листах книги, то можно продублировать код в каждый лист, но если листов много, то это довольно утомительно. Поэтому для таких целей можно использовать следующий код, который необходимо поместить уже не в модуль листа, в модуль книги:

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'если изменили более одной ячейки - ничего не отслеживаем
    Dim lcnt As Long
    'игнорируем ошибки на случай, если выделено слишком много ячеек для помещения в Long
    On Error Resume Next
    lcnt = Target.Count
    If lcnt > 1 Then Exit Sub
    On Error GoTo 0
 
    Dim vOldVal, vNewVal, sSel As String
    With Application
        'отключаем отслеживание событий
        .EnableEvents = False
        .ScreenUpdating = False
        'запоминаем текущее выделение ячеек
        'но только если они на активном листе
        If Sh.Name = Target.Worksheet.Name Then
            sSel = Selection.Address
        End If
        'запоминаем текущее значение
        vNewVal = Target.Formula
        'возвращаем предыдущее значение
        .Undo
        'запоминаем предыдущее значение
        vOldVal = Target.Formula
        'возвращаем текущее значение
        Target.Formula = vNewVal
        'если значение/формула изменились окрашиваем в красный цвет
        If vOldVal <> vNewVal Then
            Target.Interior.Color = vbRed
        End If
        'возвращаем прежнее выделение ячеек
        'но только если они на активном листе
        If Sh.Name = Target.Worksheet.Name Then
            Sh.Range(sSel).Select
        End If
        'возвращаем отслеживание событий
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Повторюсь, что этот код должен быть вставлен в модуль книги. Что такое модуль книги и где он расположен лучше подсмотреть здесь: где искать модуль книги.
Обращаю особое внимание, что в данном случае коды отслеживания изменения из конкретных листов лучше удалить, если не преследуется каких-то конкретных целей. Иначе есть шанс получить ошибку(т.к. будет неоднократный вызов методов).
Если изменения надо отслеживать во всех листах, кроме какого-то одного(например, листа с именем "Лист3"), то код можно записать так:

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Лист3" Then
        Exit Sub
    End If
    'если изменили более одной ячейки - ничего не отслеживаем
    Dim lcnt As Long
    'игнорируем ошибки на случай, если выделено слишком много ячеек для помещения в Long
    On Error Resume Next
    lcnt = Target.Count
    If lcnt > 1 Then Exit Sub
    On Error GoTo 0
 
    Dim vOldVal, vNewVal, sSel As String
    With Application
        'отключаем отслеживание событий
        .EnableEvents = False
        .ScreenUpdating = False
        'запоминаем текущее выделение ячеек
        'но только если они на активном листе
        If Sh.Name = Target.Worksheet.Name Then
            sSel = Selection.Address
        End If
        'запоминаем текущее значение
        vNewVal = Target.Formula
        'возвращаем предыдущее значение
        .Undo
        'запоминаем предыдущее значение
        vOldVal = Target.Formula
        'возвращаем текущее значение
        Target.Formula = vNewVal
        'если значение/формула изменились окрашиваем в красный цвет
        If vOldVal <> vNewVal Then
            Target.Interior.Color = vbRed
        End If
        'возвращаем текущее выделение ячеек
        'но только если они на активном листе
        If Sh.Name = Target.Worksheet.Name Then
            Sh.Range(sSel).Select
        End If
        'возвращаем отслеживание событий
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Если игнорировать надо более одного листа, то можно дописать нужные листы таким образом:
If Sh.Name = "Лист3" Or Sh.Name = "Лист6" Then
т.е. через оператор Or записывать сравнение имени листа.

Все чаще стали появляться вопросы типа "А как отследить изменения только в конкретном диапазоне?". На самом деле не очень сложно. Например, код ниже будет выделять только те ячейки, для которых значение изменили только в диапазоне B:F:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    'если изменили более одной ячейки - ничего не отслеживаем
    Dim lcnt As Long
    'игнорируем ошибки на случай, если выделено слишком много ячеек для помещения в Long
    On Error Resume Next
    lcnt = Target.Count
    If lcnt > 1 Then Exit Sub
    On Error GoTo 0
 
    Dim vOldVal, vNewVal, sSel As String
    'если изменения произошли в диапазоне "B:F" - подсвечиваем
    If Not Intersect(Target, Range("B:F")) Is Nothing Then
        With Application
            'отключаем отслеживание событий
            .EnableEvents = False
            .ScreenUpdating = False
            'запоминаем текущее выделение ячеек
            sSel = Selection.Address
            'запоминаем текущее значение
            vNewVal = Target.Formula
            'возвращаем предыдущее значение
            .Undo
            'запоминаем предыдущее значение
            vOldVal = Target.Formula
            'возвращаем текущее значение
            Target.Formula = vNewVal
            'если значение/формула изменились окрашиваем в красный цвет
            If vOldVal <> vNewVal Then
                Target.Interior.Color = vbRed
            End If
            'возвращаем текущее выделение ячеек
            Me.Range(sSel).Select
            'возвращаем отслеживание событий
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub

Строка If Not Intersect(Target, Range("B:F")) Is Nothing Then как раз и определяет входит ли измененная только что ячейка в указанный диапазон(Range("B:F")).
Вместо Range("B:F") может быть любой диапазон. И изменения будут отслеживаться только в ячейках этого диапазона.
Скачать пример:

  Подсветка изменений.xls (147,0 КиБ, 4 134 скачиваний)

Так же см.:
Как отследить событие(например выделение ячеек) в любой книге?
Ведение журнала сделанных в книге изменений
Выделение сделанных изменений
Запись изменений на листе в примечания
Каждому пользователю свой лист/диапазон

Loading

19 комментариев

  2. Дмитрий, я более чем уверен, что Вам может быть знаком данный специалист в области VBA - EducatedFool.
    Не подумайте, что я занимаюсь рекламой его сайта, но мне важно было бы воспользоваться именно Вашей формулой..., но и отказаться от надстройки я также не могу. Был бы весьма признателен, если Вы смогли уделить несколько минут Вашего драгоценного времени и опытным взглядом понять истинную проблему "конфликта" Вашей формулы и надстройки...Адрес по которому расположена надстройка http://excelvba.ru/programmes/Replacements
    P/s. Ещё раз, извините, что мог отвлечь Вас от дел насущных.

  3. Влад, дело в том, что в указанной надстройке все замены происходят в массиве(в памяти) и потом разом выгружаются на лист уже замененнные данные. А код в статье срабатывает только если изменения были произведены в одной ячейке. Для отслеживания изменений в диапазоне необходимо менять код. Причем довольно кардинально. Либо менять код в надстройке таким образом, чтобы замены производились поячеечно. Но тогда неизбежно увеличение времени работы кода.

  5. Дмитрий, использовала ваш код, но возник такой вопрос.
    У меня имеется основная таблица с формулами, которые пересчитывают результат автоматически в зависимости от заполнения других таблиц. Хотелось бы отслеживать что изменяется в этой основной таблице при внесении каких-либо изменений во второстепенные таблицы.
    Но, так как изменения в ячейки не вносятся вручную (формулы не меняются), то пересчет данных в ячейках не выделяется цветом. Возможно ли как-то решить эту проблему?

    1. Столкнулся с такой же проблемой. Формула в ячейке не меняется, соответственно при изменении ячейки, на которю ссылается формула, формула остается той же и ячейка не закрашивается, хотя значение в ней изменено

  6. Добрый день, Дмитрий. Очень понравился практичный макрос, подскажите пожалуйста новичку, как и что надо добавить, чтобы выделение цветом оставалось только на определенное время (к примеру на 2 дня). Спасибо за Ваш сайт, очень полезный.

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

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.