Excel VBA - 自动添加“更新日期”的代码

VBA Excel 更新日期单元格自动填充

最新推荐文章于 2025-07-05 16:08:42 发布

转载最新推荐文章于 2025-07-05 16:08:42 发布 · 1.4k 阅读

2 ·

CC 4.0 BY-SA版权

原文链接：https://my.oschina.net/yangbaisheng/blog/1821302

本文介绍了一个使用VBA在Excel中自动填充特定列的更新日期的解决方案。当用户在指定列范围内的任意单元格进行更改时，VBA代码会自动将当前日期时间写入该行的更新日期列。此外，代码还包括了激活工作表时查找更新日期列位置的功能，以及在选择单元格时显示指向箭头的细节。

Public lastRow As Integer
Public upd_date_col As Integer
Public upd_date_row As Integer

Private Sub Worksheet_Activate()
    Dim i As Integer, j As Integer

    upd_date_col = 0
    upd_date_row = 0

    For i = 1 To 100
        For j = 1 To 10
            If Cells(j, i) = "更新日期" Then
                upd_date_col = i
                upd_date_row = j
                Exit Sub
            End If
        Next
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    'Cells(4, 12) = "lastRow:" & lastRow
    'Cells(5, 12) = "upd_date_row:" & upd_date_row
    'Cells(6, 12) = "upd_date_col:" & upd_date_col

    If Target.Column <= 1 And Target.Column >= upd_date_col Then
        Exit Sub
    End If

    If Target.Row <= upd_date_row Then
        Exit Sub
    End If


    If upd_date_row = 0 Or upd_date_col = 0 Then
        Exit Sub
    End If

    If Target.Row > upd_date_row Then
        If Target.Column > 1 And Target.Column < upd_date_col Then
            Cells(Target.Row, upd_date_col) = Now
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim i As Integer

    'Cells(4, 14) = "lastRow:" & lastRow
    'Cells(5, 14) = "upd_date_row:" & upd_date_row
    'Cells(6, 14) = "upd_date_col:" & upd_date_col

    If lastRow > 0 Then
        Cells(lastRow, 1) = ""
        Cells(lastRow, 1).Interior.ColorIndex = 0
    Else
        For i = 1 To 1000
            If Cells(i, 1) = "->" Then
                Cells(i, 1) = ""
                Cells(i, 1).Interior.ColorIndex = 0
            End If
        Next
    End If

    Cells(Target.Row, 1) = "->"
    Cells(Target.Row, 1).Interior.ColorIndex = 6

    lastRow = Target.Row

End Sub

转载于:https://my.oschina.net/yangbaisheng/blog/1821302