Выделение сделанных изменений
Предположим есть общий файл, в который вы забиваете исходные данные и отсылаете другим людям. Но когда вам этот файл присылают обратно - неплохо бы знать в какие ячейки были внесены данные, чтобы люди при этом не выделяли эти ячейки сами каждый раз каким-нибудь цветом (пусть будет
Единственное, о чем хочу сразу предупредить - код реагирует на изменение только одной ячейки. Если разом было изменено более одной ячейки(например, выделили столбец и удалили оттуда все значения) - такие изменения код проигнорирует. Так же код отслеживает только те изменения, которые были сделаны вручную. Изменения ячеек формулами так же игнорируются. Для подобного отслеживания нужно будет приложить побольше усилий.
И так же нужно выполнить одно из важных условий: макросы должны быть разрешены. Иначе никакие изменения выделяться не будут.
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 |
Как это использовать. Щелкаем правой кнопкой мыши на ярлыке того листа, изменения в котором необходимо изменить -Исходный текст
Но приведенный код работает только в одном листе(том, в модуле которого размещен код). Если необходимо отследить изменения во всех листах книги, то можно продублировать код в каждый лист, но если листов много, то это довольно утомительно. Поэтому для таких целей можно использовать следующий код, который необходимо поместить уже не в модуль листа, в модуль книги:
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 |
Повторюсь, что этот код должен быть вставлен в модуль книги. Что такое модуль книги и где он расположен лучше подсмотреть здесь: где искать модуль книги.
Обращаю особое внимание, что в данном случае коды отслеживания изменения из конкретных листов лучше удалить, если не преследуется каких-то конкретных целей. Иначе есть шанс получить ошибку(т.к. будет неоднократный вызов методов).
Если изменения надо отслеживать во всех листах, кроме какого-то одного(например, листа с именем
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 |
Если игнорировать надо более одного листа, то можно дописать нужные листы таким образом:
т.е. через оператор
Все чаще стали появляться вопросы типа "А как отследить изменения только в конкретном диапазоне?". На самом деле не очень сложно. Например, код ниже будет выделять только те ячейки, для которых значение изменили только в диапазоне
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 |
Строка
Вместо
Подсветка изменений.xls (147,0 KiB, 4 074 скачиваний)
Так же см.:
Как отследить событие(например выделение ячеек) в любой книге?
Ведение журнала сделанных в книге изменений
Выделение сделанных изменений
Запись изменений на листе в примечания
Каждому пользователю свой лист/диапазон
Статья помогла? Поделись ссылкой с друзьями!
Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Код для страницы работает, но при клике мышью на клетку пересечения шапки строк и столбцов выдает ошибку. Клетка левее буквы A в шапке столбцов и выше цифры 1 в шапке строк
Леонид - что за ошибка? Скачал пример, выделил - нет изменений. Сделал изменения и опять выделил - нет ошибок.
Появляется окно с текстоом
run-time error(6)
overflow
ниже есть активные кнопки end debug help
при нажатии на debug
желтый курсор стоит на строчке
If Target.Count = 1 Then vValue = Target
excel 2007
также выдает эту ошибку при нажатии CTRL+A
Это ошибка не кода, а самого Excel. Причем только начиная с версии 2007 появляется ошибка с переполнением переменной Target. Можно обойти несколькими способами: использовать вместо Target.Count - Target.CountLarge, но тогда изчезнет совместимость с предыдущими версиями Excel.
Можно применить переход при возникновении ошибки - On error.
Так же можно попробовать проверять Target.Areas.Count, а если оно равно 1, то тогда Target.Rows.Count и Target.Columns.Count
Но если потом убираешь изменение, то выделение все-равно остается! Мне кажется это недостаток.. Можно его как-то устранить?
При выполнении макроса становится невозможным использовать функцию Отменить (Ctrl-Z). Тоже не очень удобно...
Это справедливо для любых макросов. Всегда приходится выбирать, что важнее: откат или возможность ведения журнала.
Дмитрий, мне как человеку, который не разбирается в VBA, прокомментируйте следующий момент. На одном из сайтов нашел надстройку для Excel. Она выполняет функцию массовой замены одних значений на другие, используя словарь значений. Нашел вашу формулу и вставил её в лист с информацией с той целью, чтобы после применения изменений в листе с помощью надстройки, смочь проследить все выполненные изменения. Но к сожалению, данная формула не помогает отследить измененные строк, в которых произошли замены. С чем может быть связана проблема ?