单元格内容改变时用批注自动记录改动情况

jack.zhou

这是个很有意思的创意，简单写了一个，支持多个单元格同时改变
如果一直记录单元格变化，是不需要“原内容”的，因为上一条历史就是“原内容”

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2.     Dim Rng As Range
   
3.     For Each Rng In Target
   
4.         If Not Rng.Comment Is Nothing Then
   
5.             Rng.Comment.Text Text:=Rng.Text & "[" & Now() & "]" & Chr(10) & Rng.Comment.Text
   
6.         Else
   
7.             Rng.AddComment Text:=Rng.Text & "[" & Now() & "]"
   
8.         End If
   
9.     Next
   
10. End Sub

复制代码

sglkp1031

可否实现保护功能，不让删除已记录批注

YZC51

jack.zhou 发表于 2020-4-20 18:05
这是个很有意思的创意，简单写了一个，支持多个单元格同时改变
如果一直记录单元格变化，是不需要“原内容 ...

学习老师的代码。谢谢老师！

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2.     Dim Rng As Range
   
3.     sj = "[" & Format(Now(), "") & "] "
   
4.     For Each Rng In Target
   
5.         If Not Rng.Comment Is Nothing Then
   
6.             Rng.Comment.Text Text:=Rng.Comment.Text & Chr(10) & sj & Rng.Text
   
7.             pzh = UBound(Split(Rng.Comment.Text & "] ", "]")) - 1
   
8.             Rng.Comment.Shape.Width = 150               '定义批注宽度等于单元格列宽
   
9.             Rng.Comment.Shape.Height = 11.5 * pzh       '定义批注高度
   
10.         Else
    
11.             Rng.AddComment Text:=sj & Rng.Text
    
12.         End If
    
13.     Next
    
14. End Sub
    

复制代码

YZC51

代码审核中
图片

YZC51

请参考
单元格内容改变时用批注自动记录改动.zip (13.42 KB, 下载次数: 129)

2020-4-21 16:48 上传

点击文件名下载附件

淡定哥阿伟

xrs08234 发表于 2018-12-14 11:00
按照你的要求，对代码做了一些优化：
1、实现了多个连续单元格用粘贴时，可以记录并不会把原复制的单元 ...

从其他工作薄复制粘贴数据时只能对第一个单元格自动添加批注，并报错

淡定哥阿伟

淡定哥阿伟 发表于 2020-6-4 09:29
从其他工作薄复制粘贴数据时只能对第一个单元格自动添加批注，并报错

不好意思，最好的回复没看到

a57403080

YZC51 发表于 2018-12-13 17:24
或者
Dim oldvalue
Private Sub Worksheet_Change(ByVal Target As Range)

yang央

这个功能很酷炫,实际没啥用..

57wk

YZC51朋友，依附件来看，您批注中的内容是修改后“当前数据”的显示数据！我想楼主的意思应该是记录被修改的原数据内容（且这才是有意义的——知晓被改动单元格之前后的数据）。