作者：绿色风
分类：
时间：2022-08-18
浏览：94
楼主
nothingwmm |
要求:实验数据的记录如果是一次性输入的话，就正常显示，如果被修改过，则将修改的日期时间和内容自动添加到相应单元格的批注里，避免实验数据的假记录。需要追踪每一次修改记录。一下代码由KevinChengcw版主原创。将所有操作记录过程保存一个表格里，并且深度隐藏。
- Dim Dic As Object
- Private Sub Workbook_Open()
- Dim Rng As Range
- Set Dic = CreateObject("scripting.dictionary")
- For Each Rng In Selection
- Dic.Add Rng.Address, Rng.Formula
- Next Rng
- End Sub
- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
- Dim Rng As Range
- Application.EnableEvents = False
- If Sh.Name <> Sheet4.Name Then
- For Each Rng In Target
- If Dic(Rng.Address) <> Rng.Formula Then
- With Sheet4.Cells(Sheet4.Cells(Sheet4.Rows.Count, 1).End(3).Row + 1, 1)
- .Value = Sh.Name
- .Offset(, 1) = Rng.Address
- .Offset(, 2) = Dic(Rng.Address)
- .Offset(, 3) = Rng.Value
- .Offset(, 4) = Now
- .Offset(, 5) = Application.UserName
- End With
- End If
- Next Rng
- End If
- Application.EnableEvents = True
- End Sub
- Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
- Dim Rng As Range
- On Error Resume Next
- If Sh.Name <> Sheet4.Name Then
- Dic.RemoveAll
- For Each Rng In Intersect(Target, Sh.UsedRange)
- Dic.Add Rng.Address, Rng.Formula
- Next Rng
- End If
- End Sub
这样的报表供实验人员如实填写，如果需要查看，添加一下模块，就可以进行“解密”了。类似于参看黑匣子哦。
- Sub test()
- For Each Sh In ActiveWorkbook.Sheets
- Sh.Visible = True
- Next
- End Sub
 如实填写实验数据 填写版.rar
|
2楼
余方方 |
谢谢分享
 |
3楼
纵鹤擒龙水中月 |
谢谢分享 |
4楼
我是小马儿 |
类似log,这个好。 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一