VBA-历史记录批注显示

目录

 

一、操作展示Demo

二、源码剖析

2.1、模块代码

2.2、操作表代码

 三、场景应用

四、注意点

五、Demo文件下载链接

---

一、操作展示Demo

 

二、源码剖析

2.1、模块代码

' 根据列名查找列号函数
Public Function intFindColumnID(ByVal rowID, ByRef objWorkBook, ByRef objWorkSheet, ByVal strColumnName) As Integer
    objWorkBook.Activate
    objWorkSheet.Select
    objWorkSheet.Cells(1, 1).Select
    On Error Resume Next
    Cells.Find(What:=strColumnName, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
        
    areaContent = Selection.Text    ' 选中区域的值
    If Selection.row = rowID And areaContent = strColumnName Then
        intFindColumnID = Selection.column
    Else
        intFindColumnID = 0
    End If
End Function

2.2、操作表代码

Dim oldValue As String
Dim CurrentTime, CurrentDate
Dim objWorkBook As Workbook
Dim objOperSheet As Worksheet   ' 操作表
Dim objRecordSaveSheet As Worksheet   ' 记录保存表
Dim srcColNo As Integer ' 源列编号(操作表)
Dim dstColNo As Integer ' 目的列编号(记录保存表)

Private Sub Worksheet_Change(ByVal Target As Range)
CurrentTime = Time
CurrentDate = Date
user = Environ("username")

Set objWorkBook = ThisWorkbook  '指定工作簿
Set objOperSheet = objWorkBook.Sheets("操作表")   '指定工作表
Set objRecordSaveSheet = objWorkBook.Sheets("记录保存表")   '指定工作表
targetColumnTitleName = "最新服务"  '指定要查找的列标题

' 1、合法性校验
pos = InStr(Target.Address, ":")    ' 如果目标地址包含:符号，则是删除行/列操作
If pos > 0 Then
    Exit Sub
End If

oldValue = Target.Value    '记录了单元格的旧值
row = Target.row           '保存变动单元格所在行编号
column = Target.column     '保存变动单元格所在列编号
srcColNo = intFindColumnID(1, objWorkBook, objOperSheet, targetColumnTitleName)  '调用列号查找函数
    
If column = srcColNo Then   '如果是源列单元格变动
    oldContent = objRecordSaveSheet.Range("B" & row).Value
    
    idx = InStr(oldContent, oldValue) ' 如果修改内容已经存在于记录中不做保存，这块根据需求再自定义下
    If idx > 0 Then
        MsgBox "修改内容已存在,请确认！" & Chr(10) & "内容:" & oldValue
        Exit Sub
    End If
    
    newContent = "[" & CurrentDate & "-" & CurrentTime & "]: By [" & user & " ]: " & oldValue & Chr(10) & oldContent  ' 记录下最新内容
    objRecordSaveSheet.Range("B" & row).Value = newContent
    add_notes newContent, row, column
    objOperSheet.Cells(row, column).Select
End If
End Sub

Sub add_notes(ByVal newInfo As String, ByVal row As Long, ByVal column As Long)

' 注意：此处不能再用ActiveCell获取活动单元格所在行列，坐标值需要当做入参传进来
'       此时获取的ActiveCell坐标有两种情况：1、编辑单元格后回车——>在编辑单元格下一行
'                                           2、编辑单元格后鼠标点击其它单元格——>活动单元格为鼠标点击处
'row = ActiveCell.row        ' 活动单元格所在行
'column = ActiveCell.column  ' 活动单元格所在列

'Debug.Print newInfo ' 立即窗口打印下内容，便于调试

objOperSheet.Cells(row, column).ClearComments
objOperSheet.Cells(row, column).AddComment newInfo
objOperSheet.Cells(row, column).Comment.Visible = False
objOperSheet.Cells(row, column).Comment.Shape.TextFrame.AutoSize = True

End Sub

 

 三、场景应用

1、对单元格内容操作的记录保存。类似于SVN或GIT。

2、对变更历史自动加入到批注中，便于查看历史记录。

3、有内容重复提示功能。（可根据需要进行自定义需求）

 

四、注意点

1、如果删除某行内容，两个表【操作表】和【记录保存表】联动删除根据用户需求进一步自定义处理。

2、内容重复提示功能可根据用户需求进一步自定义处理。

3、记录保存表可以隐藏/恢复。

 

五、Demo文件下载链接