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)
    'если изменили более одной ячейки - ничего не отслеживаем
    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 KiB, 4 074 скачиваний)

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


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

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

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

    Код для страницы работает, но при клике мышью на клетку пересечения шапки строк и столбцов выдает ошибку. Клетка левее буквы A в шапке столбцов и выше цифры 1 в шапке строк

  2. Леонид - что за ошибка? Скачал пример, выделил - нет изменений. Сделал изменения и опять выделил - нет ошибок.

  3. Леонид:

    Появляется окно с текстоом

    run-time error(6)

    overflow

    ниже есть активные кнопки end debug help

    при нажатии на debug

    желтый курсор стоит на строчке

    If Target.Count = 1 Then vValue = Target

  4. Леонид:

    excel 2007

  5. Леонид:

    также выдает эту ошибку при нажатии CTRL+A

  6. Это ошибка не кода, а самого Excel. Причем только начиная с версии 2007 появляется ошибка с переполнением переменной Target. Можно обойти несколькими способами: использовать вместо Target.Count - Target.CountLarge, но тогда изчезнет совместимость с предыдущими версиями Excel.
    Можно применить переход при возникновении ошибки - On error.
    Так же можно попробовать проверять Target.Areas.Count, а если оно равно 1, то тогда Target.Rows.Count и Target.Columns.Count

  7. Елена:

    Но если потом убираешь изменение, то выделение все-равно остается! Мне кажется это недостаток.. Можно его как-то устранить?

  8. Петя:

    При выполнении макроса становится невозможным использовать функцию Отменить (Ctrl-Z). Тоже не очень удобно...

  9. Это справедливо для любых макросов. Всегда приходится выбирать, что важнее: откат или возможность ведения журнала.

  10. Влад:

    Дмитрий, мне как человеку, который не разбирается в VBA, прокомментируйте следующий момент. На одном из сайтов нашел надстройку для 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 для всех   Войти