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