VBA自动记录时间------区域内容发生修改，指定列自动填入当前时间

马可瓦尔多_

已于 2023-02-26 10:55:35 修改

阅读量3.5k

点赞数 5

分类专栏： VBA Excel 文章标签：经验分享

于 2022-11-19 10:56:10 首次发布

本文链接：https://blog.csdn.net/qq_38704425/article/details/127933510

版权

Excel 同时被 2 个专栏收录

3 篇文章 0 订阅

订阅专栏

VBA

2 篇文章 1 订阅

订阅专栏

功能需求

在Excel数据工作表中，指定区域内容发生数据修改时，在A列记录修改类型（增加，修改，删除），然后再J列记录修改时间。

手动输入比较麻烦，希望在A列记录修改类型后，J列中自动记录修改时间。具体功能如下

1）表格A列内容发生增加，修改，删除操作时，在J列记录当前时间。

2）在B列中有数据时，才记录当前时间，防止对空数据行误操作。

3）支持多行同时操作，方面多行同时记录数据。

总的来说，就是指定区域内容发生修改时，在指定列记录当前时间。

函数实现方法

如果只是第一次数据录入时，可以通过函数实现。在J列录入下述函数。

=IF($A1="","",IF($B1<>"",NOW(),""))

上述函数可实现当A列新增内容时，如果B列对应行内容不为空，那么在J列对应行自动记录当前时间。（仅限第一次数据输入时）

但是修改数据时，函数实现不会重新记录修改时间。

VBA实现方法

打算VBA中的工作表事件来实现上述功能。

使用WorkSheet_Change,Worksheet_SelectionChange两个事件来实现上述功能。代码如下

Option Explicit

Const TARGET_RNG = "A:A"  '指定事件发生的目标区域
Const Ref_col = "b"  '指定参考列，事件发生行对应的参考列中有数据时，事件才有效
Const date_col = "j" '指定事件发生时，日期计入区域

Dim old_value
Dim old_ref_col_value

Private Sub Worksheet_Change(ByVal Target As Range)

Dim num
Dim mod_cell
Dim area_judge
Dim value_pre
Dim row_process

On Error Resume Next '防止异常动作发生时，导致程序被中断，例如插入空行

Application.EnableEvents = False '防止事件被重复触发

'MsgBox Target.Address
'MsgBox Target.Columns.Count

num = 0
row_process = (Target.Columns.Count > 256) '当事件对象的行数大于256时，判断为行操作

For Each mod_cell In Target.Cells '同时处理多个单元格时，循环判断
    Set area_judge = Application.Intersect(Range(TARGET_RNG), mod_cell) '判断单元格是否在目标区域
        If Not area_judge Is Nothing And Not row_process Then  '当事件发生在目标列 且 非行操作时，进入判断，否则跳转Next
            If mod_cell.Count <> 1 Then
                value_pre = old_value(num + 1, 1) '处理多个单元格时，判断是否发生修改
            Else
                value_pre = old_value  '处理单个单元格时，判断是否发生修改
            End If

            If mod_cell.Text <> value_pre And old_ref_col_value <> "" Then '单元格发生了修改，而且参考列中有数据时
                If mod_cell.Text <> "" Then                                '修改后的单元格不等于空，填入当前时间
                    Range(date_col & mod_cell.Row).Value = Now
                Else
                    Range(date_col & mod_cell.Row).Value = ""              '修改后的单元格等于空，即删除操作，日期列清空
                End If
            End If
        End If
Next
Application.EnableEvents = True '恢复事件有效
On Error GoTo 0                 '错误发生进入中断
                
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = True '事件有效

old_value = Target.Value                                     '单元格被选中时，存储当前值，用于比较修改后的单元格值是否发生变化，避免进入编辑状态但未修改情况触发事件
old_ref_col_value = Range(Ref_col & Target.Row).Value        '单元格被选中时，存储参考列的值，值不为空时，事件才有效

End Sub

代码例中实现功能：

1）在A列中内容发生增加，修改，而且对应的B列有数据时，在J列自动记录当前时间。

2）当发生删除操作时，清空J列的记录。

3）多行同时发生变化时，能够同时记录时间。