Запись изменений на листе в примечания
3517
Что умеет Excel
Сегодня от нечего делать решил написать эту статью. Может кому пригодится. Приведенный ниже код создает примечание в ячейке, если её значение было изменено. В примечание заноситься информация о том, что было занесено в ячейку и когда это было занесено. Если примечание в ячейке уже есть, то в имеющееся примечание допишется информация об изменениях.
Private Sub Worksheet_Change(ByVal Target As Range) 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
Private Sub Worksheet_Change(ByVal Target As Range)
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Код необходимо поместить в модуль листа(щелкнуть правой кнопкой мыши по ярлычку листа — Исходный текст), изменения на котором необходимо отследить. Подробнее о модулях см.здесь.
Если хотите, чтобы в примечание заносилось предыдущее значение в ячейке и ограничить диапазон отслеживания изменений, то следует применить такой код:
Option Explicit Public sValue As String 'заносим в переменную значение ячейки Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count = 1 Then sValue = Target.Value End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) 'отслеживаем изменения только в диапазоне "A1:B10" If Intersect(Target, Me.Range("A1:B10")) Is Nothing Then Exit Sub 'сравниваем новое значение с прежним If CStr(Target.Value) <> sValue Then Dim oComment As Comment On Error Resume Next Set oComment = Target.Comment If oComment Is Nothing Then 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 End If End Sub
Option Explicit
Public sValue As String
'заносим в переменную значение ячейки
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
sValue = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'отслеживаем изменения только в диапазоне "A1:B10"
If Intersect(Target, Me.Range("A1:B10")) Is Nothing Then Exit Sub
'сравниваем новое значение с прежним
If CStr(Target.Value) <> sValue Then
Dim oComment As Comment
On Error Resume Next
Set oComment = Target.Comment
If oComment Is Nothing Then
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
End If
End SubТак же в данном коде перед значением добавляется имя пользователя, изменившего значение.
Хочу обратить внимание, что при попытке изменения нескольких ячеек сразу может возникнуть ошибка выполнения.
Tips_Macro_ChangesInComment.xls (25,5 KiB, 1 163 скачиваний)
Так же см.:
→Ведение журнала сделанных в книге изменений
→Выделение сделанных изменений
Подскажите пожалуйста!
1.Если в строчку скопировать значение, то все комментарии которые там были удаляются.
2.Больше 3 коментариев не вмещается.
Можно это все устранить!
1. Вы явно копируете не только значения. Судя по результату Вы копируете ячейки целиком.
2. Вмещается больше. Просто надо изменить размер примечания, т.к. не все вмещаются в размер примечения.
Мне кажется, что лучше бы в примечании отображалось значение ячейки, которое было до внесения изменений. Т.к. новое значение и так видно, достаточно только даты, когда оно было сделано.
Можно ли дописать код, чтобы это действовало только на определённый диапазон ячеек листа, а не на весь лист. Сейчас получается, что весь лист со временем будет в примечаниях.
Заранее благодарен,
Андрей.
Андрей, это конечно так. Но. Внесли одно изменение, затем другое. А старое значение осталось в примечании. В любом случае, расширить можно. Но только сами. В этой статье: можете посмотреть реализацию запоминания старого значения и применить к данной статье.
Дмитрий, не могли бы Вы ответить и на вторую часть моего комментария? (про диапазон ячеек)
Конечно.
Первой строкой кода пишите:
If Intersect(Target, Me.Range("A1:B10")) Is Nothing Then Exit Subгде «A1:B10″ это диапазон, изменения в котором отслеживаются.
Спасибо, работает.
Не хочу злоупотреблять…
Я не смог разобраться с «предыдущим значением ячейки в ком-те»
Может за скромную плату допишите?
(Нужно, чтобы указывалось предыдущее значение(вместо нового) и Автор изменений, если он (Автор) изменился.)
Заранее благодарен,
Андрей.
Добавил в статью код записи прежнего значения и всего остального. Пример к статье так же изменен.
В коменте по прежнему отображается новое значение.
Может я что не так вставил, (скопировал весь код и вставил как есть.)
«Автор изменений, если он (Автор) изменился» — иначе Автор пишется каждый раз, примечание увеличивается вдвое и не несет информативности. Может это уже слишком…?
Исправил ошибку про запись «прежнего» значения. А вот с автором — да, это уже слишком. Здесь надо морочиться. Андрей — либо изуйчайте VBA, либо переносим общение в личную почту.
Давайле в личку.
Заметил ещё одну проблемку: если до этого в ячейке уже был коммкетарий, то после изменения значения ячейки текст и старый и новый становится жирным.
Дмитрий, пожалуйста удалите мои лишние посты.
Модуль полезный, но недоделанный.
На счет первого варианта: приведите пожалуйста пример, когда в примечании необходимо отображать значение, которое отображено в ячейке.
Если код не выполняет условия именно ВАШЕЙ задачи, это не значит, что он недоделанный. Ищите доделанные тогда.
Дмитрий, огромаднейшее спасибо, нашел прямо то, что искал!
Единственный вопрос: а можно ли сделать так (и как?), чтобы примечание появлялось не при первом вводе значения, а только при его изменении?
Начальству, я думаю понравится, с премии поддержу!
В принципе можно. Но код необходимо доработать процедурой из второго кода. Если и так второй код используете, то вариант:
Private Sub Worksheet_Change(ByVal Target As Range) 'отслеживаем изменения только в диапазоне "A1:B10" If Intersect(Target, Me.Range("A1:B10")) Is Nothing Then Exit Sub 'проверяем, было ли значение в ячейке до этого If sValue = "" Then Exit Sub 'сравниваем новое значение с прежним If CStr(Target.Value) <> sValue Then 'далее все так жеСпасибо, Дмитрий!!!
Работает, ништяк, с меня причитается на пиво!