VBA之计算两个日期之间相差几点几个月

计算选中的Excel单元格中两个日期之间相差几点几个月

日期格式如下(起始日期-结束日期)：
YYYY/MM/DD-YYYY/MM/DD

Sub CalcMonth()
    'I Love you, Baby!
    Dim BegDate, EndDate, Msg
    Dim y, m, d, num
    Dim i, j, cnt, start, over

    'BegDate = InputBox("请输入起始日期：", , Format(Date, "yyyy/mm/dd"))
    'EndDate = InputBox("请输入结束日期：", , Format(Date, "yyyy/mm/dd"))

    'i行j列

    'MsgBox Selection.Count
    'MsgBox Range(Selection.Address).Row
    'MsgBox Range(Selection.Address).Column

    ActiveSheet.Columns(Range(Selection.Address).Column + 1).Insert

    ActiveSheet.Columns(Range(Selection.Address).Column + 1).Interior.ColorIndex = xlNone
    ActiveSheet.Columns(Range(Selection.Address).Column + 1).ColumnWidth = 8
    ActiveSheet.Columns(Range(Selection.Address).Column + 1).HorizontalAlignment = xlCenter
    ActiveSheet.Columns(Range(Selection.Address).Column + 1).VerticalAlignment = xlCenter

    i = Range(Selection.Address).Row
    j = Range(Selection.Address).Column
    cnt = Selection.Count
    start = Range(Selection.Address).Row
    over = Range(Selection.Address).Row + cnt - 1

    For i = start To over
        num = 0
        num = Application.WorksheetFunction.Search("-", ActiveSheet.Cells(i, j))
        'MsgBox num

        BegDate = VBA.Mid(ActiveSheet.Cells(i, j), num - 10, 10)
        EndDate = VBA.Mid(ActiveSheet.Cells(i, j), num + 1, 10)

        'MsgBox BegDate
        'MsgBox EndDate

        y = 0
        m = 0
        d = 0

        d = Day(EndDate) - Day(BegDate)
        If d < 0 Then
            m = m - 1
            d = d + 30
        End If
        m = m + Month(EndDate) - Month(BegDate)
        If m < 0 Then
            y = y - 1
            m = m + 12
        End If
        'MsgBox Year(EndDate)
        'MsgBox Year(BegDate)
        y = y + Year(EndDate) - Year(BegDate)
        If y < 0 Then
            MsgBox "开始日期必须小于等于结束日期!"
        Else
            res = y * 12 + m + d / 30
            'MsgBox "两者相差" & Round(res, 2) & "个月"
            'CopyToClipbox Round(res, 2)
            ActiveSheet.Cells(i, j + 1) = Round(res, 2)
        End If
    Next
End Sub

Sub CopyToClipbox(strText As String)
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText strText
        .PutInClipboard
    End With
End Sub