用VBA根据日期自动计算到期日期和时间

深秋红叶2019

用代码实现，在M列手动输入日期，N列自动计算为1年的到期日期，（日期要考虑366和365，月份也一样），然后O列自动计算剩余天数，如果删除M列的数据则不计算，谢谢老师

liulang0808

Private Sub Worksheet_Change(ByVal t As Range)
    If t.Count > 1 Then Exit Sub
    If t.Column = 13 And t.Row > 6 Then
        If VBA.IsDate(t) Then
            y = Year(t)
            m = Month(t)
            d = Day(t)
            Application.EnableEvents = False
            t.Offset(0, 1) = CDate(y + 1 & "-" & m & "-" & d)
            t.Offset(0, 2) = t.Offset(0, 1) - Date
            Application.EnableEvents = True
        End If
    End If
If t.Row > 6 And t.Column = 2 Then

    If t.Value = "" Then Rows(t.Row).Delete: Exit Sub
    Set rng = Sheets("学员信息建档").Columns(1).Find(t.Value, , , 1)
    If rng Is Nothing Then MsgBox "学员信息建档中没有该电话！": Exit Sub
    r = rng.Row
    For j = 2 To 8
        t.Offset(, j - 1) = Sheets("学员信息建档").Cells(r, j)
    Next j
    t.Offset(, -1) = Now()
End If
End Sub

liulang0808

补充在之前的事件中。。。。。。

深秋红叶2019

liulang0808 发表于 2020-1-31 13:07
补充在之前的事件中。。。。。。

很好用，要是删除指定日期后不计算会更好，我试了一下删除日期后计算出来的日期和天数还在，老师加个代码可以吗，非常感谢，现在天天在家无聊一直在折腾这个表
老师这个帖子可以再帮我一下不http://club.excelhome.net/thread-1519411-1-1.html

liulang0808

深秋红叶2019 发表于 2020-1-31 14:29
很好用，要是删除指定日期后不计算会更好，我试了一下删除日期后计算出来的日期和天数还在，老师加个代码 ...

之前的帖子有雷同回复，楼主参考之前的吧

深秋红叶2019

liulang0808 发表于 2020-1-31 15:28
之前的帖子有雷同回复，楼主参考之前的吧

我加了一条代码，可以把整行数据都删了，后面想了一下，不是同一功能，不适用，现在还没好懂

liulang0808

If VBA.IsDate(t) Then
            y = Year(t)
            m = Month(t)
            d = Day(t)
            Application.EnableEvents = False
            t.Offset(0, 1) = CDate(y + 1 & "-" & m & "-" & d)
            t.Offset(0, 2) = t.Offset(0, 1) - Date
            Application.EnableEvents = True
else
Application.EnableEvents = False
            t.Offset(0, 1) =""
            t.Offset(0, 2) =""
            Application.EnableEvents = True
        End If

深秋红叶2019

liulang0808 发表于 2020-1-31 15:50
If VBA.IsDate(t) Then
            y = Year(t)
            m = Month(t)

奇怪，我用的是WPS，可能是版本的问题

liulang0808

If VBA.IsDate(t) Then
            y = Year(t)
            m = Month(t)
            d = Day(t)
            Application.EnableEvents = False
            t.Offset(0, 1) = CDate(y + 1 & "-" & m & "-" & d)
            t.Offset(0, 2) = t.Offset(0, 1) - Date
            Application.EnableEvents = True
end if
if len(t)=0 then
Application.EnableEvents = False
            t.Offset(0, 1) =""
            t.Offset(0, 2) =""
            Application.EnableEvents = True
        End If

深秋红叶2019

liulang0808 发表于 2020-1-31 15:58
If VBA.IsDate(t) Then
            y = Year(t)
            m = Month(t)

可以，老师，这个帖子帮一下忙