VBA编写的Excel工作表操作留痕小工具

xhlbudd

用VBA编写的Excel工作表操作留痕小工具分享给大家，对工作表的单元格任何修改之后，程序会自动以注释的形式标明修改前后的内容，以及修改时间（精确到秒）， 如软件截图所示。小工具为带宏的Excel文件（xlsm）格式，小巧轻盈，仅19KB，可以用于个人以及小团队的数据分享，放在共享盘，可以追踪所有单元格的更改记录，希望对大家有帮助~~

通过百度网盘分享的文件：Excel工作表操作留痕
链接: https://pan.baidu.com/s/1pF4BxskDZBWrcCRyFBmEHA?pwd=52pj 提取码: 52pj

同时把源代码分享如下，请吾爱的大神们多多指点：

[Visual Basic] 纯文本查看 复制代码

Option Explicit

' 模块级变量：保存修改前的值
Private oldValue As String

' 选中单元格时记录旧值
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    On Error Resume Next
    oldValue = CStr(Target.Value)
    If Err.Number <> 0 Then oldValue = "无法读取"
    On Error GoTo 0
End Sub

' 单元格内容变化时写入批注
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    Dim newValue As String
    newValue = CStr(Target.Value)
    
    ' 如果内容没变，直接退出
    If newValue = oldValue Then Exit Sub
    
    Application.EnableEvents = False
    
    Dim cmt As Comment
    Set cmt = Target.Comment
    
    ' 没有批注就新建
    If cmt Is Nothing Then
        Set cmt = Target.AddComment
    End If
    
    ' 构造批注内容
    Dim logText As String
    logText = _
        IIf(cmt.Text <> "", cmt.Text & vbCrLf, "") & _
        Format(Now, "yyyy-mm-dd hh:mm:ss") & " " & _
        "原内容：" & oldValue & "；" & _
        "修改为：" & newValue
    
    ' 写入批注
    cmt.Text Text:=logText
    
    ' 自动调整批注大小
    cmt.Shape.TextFrame.AutoSize = True
    
    Application.EnableEvents = True
End Sub

yptkyp

之前代码不完善
最终完整版代码（工作簿全局生效）
这个代码会：
对当前 Excel 文件里所有工作表自动记录修改痕迹
记录：修改时间 + 原值 + 新值
自动创建 / 追加批注
不会重复记录相同内容
关闭事件防止死循环
全局生效，不需要每个表粘贴代码

[Visual Basic] 纯文本查看 复制代码

Option Explicit

' 工作簿级变量：保存所有工作表修改前的值
Private oldValue As String

' ==============================
' 选中任意单元格时记录旧值
' ==============================
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ' 只处理单个单元格
    If Target.Cells.CountLarge > 1 Then Exit Sub
   
    On Error Resume Next
    oldValue = CStr(Target.Value)
    If Err.Number <> 0 Then oldValue = "无法读取"
    On Error GoTo 0
End Sub

' ==============================
' 任意工作表单元格修改时记录痕迹
' ==============================
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 只处理单个单元格
    If Target.Cells.CountLarge > 1 Then Exit Sub
   
    Dim newValue As String
    newValue = CStr(Target.Value)
   
    ' 内容未变化则不记录
    If newValue = oldValue Then Exit Sub
   
    ' 关闭事件防止重复触发
    Application.EnableEvents = False
   
    Dim cmt As Comment
    Set cmt = Target.Comment
   
    ' 无批注则新建
    If cmt Is Nothing Then
        Set cmt = Target.AddComment
    End If
   
    ' 构造修改痕迹日志
    Dim logText As String
    logText = _
        IIf(cmt.Text <> "", cmt.Text & vbCrLf, "") & _
        Format(Now, "yyyy-mm-dd hh:mm:ss") & " " & _
        "原内容：" & oldValue & "；" & _
        "修改为：" & newValue
   
    ' 写入批注
    cmt.Text Text:=logText
   
    ' 自动调整批注大小
    cmt.Shape.TextFrame.AutoSize = True
   
    ' 恢复事件
    Application.EnableEvents = True
End Sub

最重要：代码必须放在 ThisWorkBook 里
这是让所有工作表都生效的关键！
放置步骤：
打开你的 Excel 文件
按 Alt + F11 打开 VBA 编辑器
在左侧 工程窗口 找到：
VBAProject (你的文件名.xlsm)
展开 → 双击 ThisWorkbook
把右侧空白处原有代码全部删除
粘贴我上面给你的完整代码
保存文件为 .xlsm 启用宏的工作簿
关闭 VBA 编辑器，返回 Excel
这样设置后：
✅ 所有工作表 都会自动记录修改痕迹
✅ 不需要给每个表单独加代码
✅ 精准记录每一次修改
✅ 批注自动追加、自动调整大小
三、如何查看 / 运行这个宏（你要求的 “显示代码，运行的 vba 宏”）
你可以随时这样打开并运行：
Alt + F11 → 打开 VBA
左侧点 ThisWorkbook
就能看到完整代码
若要手动运行：
把光标放在任意过程里
按 F5 即可运行
四、功能说明（你要的精准效果）
工作簿全局生效：所有工作表都能记录
多次修改精准记录：每次修改都会追加一行日志
不重复记录：内容不变不会生成批注
自动批注：没有批注就新建，有就追加
时间格式：yyyy-mm-dd hh:mm:ss
安全稳定：关闭事件防止卡死，错误处理不崩溃
总结
代码已从工作表级升级为工作簿级，所有工作表通用
必须粘贴到 ThisWorkbook 模块
保存为 .xlsm 格式
任意单元格修改 → 自动生成修改痕迹批注
你直接复制粘贴就能用，不需要任何修改！

douyacai

这个真好，针对反复修改的那种文档太实用了。

miocaro507

代码很规整，学习一下

excess1989

嗯，不错不错，感谢分享

chmephisto

这个真不错啊

xhlbudd

谢谢大家的支持，虽然是代码比较简单的小工具，还是比较实用的，欢迎大家提出宝贵意见，以便持续改进~~

xxkz

怎么使用呢？宏直接启动？

wzzhal123

这个实用

yp5768

和共享excel文件放一个目录下就行是啵，支持wps表格啵

夏季

有想法！我之前是用一个工作表单独存放的修改信息，表头，日期-表格名-修改前-修改后-操作单元格-用户名。这样式的。主要这VBA不能应用于在线金山文档表格。实在难搞。金山表格就JS和PY。不会