【vba】Excel 记录/修改 记录的更新时间（使用Worksheet_Change、Workbook_SheetChange事件）

功能概述：

　　用指定列来记录对应行数据是否有更新，如果更新（增删改），则将当前日期记录到对应单元格中。

一、运行前准备

运行前准备二选一，由于Excel2007版本以上，基于安全考虑微软将Excel数据文件与脚本文件分离，数据文件xlsx，脚本文件xlsm。但是2003以下版本数据文件和脚本文件是可以同时保存的。

所以如果是2007以上版本，要么另存后xlsm后添加运行脚本；要么另存为xls后添加运行脚本。

以下是两种方案

1、基于2007以上版本 -xlsx

　　1）修改“保存时从文件属性中删除个人信息(R)”,取消√

设置调整后保存vba脚本才不会报错

 

　　2）Excel文件另存为.xlsm文件，因为从2003版本以后为了安全，Excel文件跟脚本文件分开。

在.xlsx下保存vba脚本时报错信息

  

2、基于2003以下版本-xls

将文件另存为2003以下版本.xls 

 

二、添加脚本代码

1、鼠标右键单击工作表——“查看代码”   或通过快捷键“Alt+F11”

2、将代码粘贴进去，并保存关闭即可。

 

三、代码内容1-基于工作表Worksheet

'功能概述：用指定列来记录对应行数据是否有更新，如果更新（增删改），则将当前日期记录到对应单元格中。
'实现逻辑
'1.通过Worksheet_SelectionChange事件获取修改前的值
'2.通过变量tagCol设置要记录修改记录的列
'3.循环判断修改后的单元格所在的行（除用来记录修改记录的单元格tagCol外）是非空nulFlag=True并直接退出循环
'4.判断修改的列为非tagCol列，且该行有记录非空nulFlag=True，且修改前和修改后的值不相等，则将tagCol的值修改为当前日期date()
'5.如果tagCol为空nulFlag=False，则清空tagCol

Option Explicit
Dim oldValue
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'用此事件获取修改前的值
    oldValue = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next  '跳过异常
On Error GoTo MyErr
'用此事件获取修改后的值
    Dim row '事件所在的行
    Dim tagCol, col '记录时间的列
    Dim nulFlag '对应行数据单元格是否非空
    Dim i
    row = Target.row
    col = Target.Column
    tagCol = 8 ' 第8列 "H",即
    nulFlag = False '用来判断光标所在的行是否为非空，非空为True，空为False
    
    '启用事件
    'Application.EnableEvents = True
    
    '判断从该行从1-8内容是否非空
    For i = 1 To tagCol - 1 '最后一列除外
        If Application.WorksheetFunction.CountA(Cells(row, i)) <> 0 Then
            nulFlag = True
            Exit For '如果判断目标行有非空单元格，则退出循环
        End If
    Next
    
    
    '非tagCol值发生变化，更新tagCol列
    If col <> tagCol And nulFlag = True And oldValue <> Target.Value Then
        Cells(row, tagCol) = Date
    End If
    If nulFlag = False Then
        Cells(row, tagCol) = ""
    End If
    
    '禁用事件
    'Application.EnableEvents = False
MyErr:
    'MsgBox " 错误 " & Err.Number & " ： " & Err.Description
    Resume Next
End Sub

四、代码逻辑2-基于工作簿Workbook

基于“三、代码内容1-基于工作表Worksheet” 的代码逻辑存在性能和逻辑上的瓶颈，说明如下：

1、以上基于工作表Worksheet的事件，每个工作表都要copy一份代码，而基于工作簿Workbook的事件只需要一份代码即可。

2、以上判断整列是否为空，为空则不处理需要循环逐条判断，判断次数较多，效率低；本次直接对整行使用CountA函数，仅进行一次判断，统计为0则退出事件

3、怎么使用？打开VBE（方式之一：鼠标右键单击工作表名称，例如Shee1——查看代码——将代码复制到ThisWorkbook中），如图：

4、代码逻辑如下：

Dim oldvalue '全局变量，用来记录单元格修改前的值

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    '记录单元格修改前的值
    oldvalue = Target.Value
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next  '跳过异常
    
    Application.ScreenUpdating = False '关闭屏幕更新

    '排除特定工作表，如果工作表名称时如下名称，则退出事件
    If Sh.Name = "转置" Or Sh.Name = "工资条" Or Sh.Name = "商品名称" Then
        Exit Sub
    End If
    
    Dim tagCol
    tagCol = 8 '“修改日期”字段所在工作表的列数，此表为第8列,用逻辑来识别该参数逻辑较为复杂（效率比较低），直接写死即可
    '判断第1列到“修改日期”列中是否有值，没有值则退出事件
    If Application.WorksheetFunction.CountA(Range(Cells(Target.row, 1), Cells(Target.row, tagCol))) = 0 Then
        Exit Sub
    End If
        
    '如果同时选择操作多个单元格，仅处理选中区域内的第一个单元格
    If Target.Column > 1 Then
        Set Target = Target.Cells(1)
    End If
    
    '判断新旧值不相等，且修改的单元格的列要在“修改日期”的列之前（不包含）
    If Target.Value <> oldvalue And Target.Column < tagCol Then
        Cells(Target.row, tagCol) = Date
    End If

    Application.ScreenUpdating = True '恢复屏幕更新
End Sub

五、测试

修改其中一个值，观察“修改日期”单元格内容是否变化