解决计算1900/01/01以前年龄问题

浮誇

Public Function AgeFunc(stdate As Variant, endate As Variant)
    Dim stvar$, stmon$, stday$, styr$
    Dim endvar$, endmon$, endday$
    Dim endyr$, stmonf%, stdayf%
    Dim styrf%, endmonf%, enddayf%
    Dim endyrf%, years%, fx%


    fx = 0
    stvar = sfunc("/", stdate)
    stmon = Left(stdate, sfunc("/", stdate) - 1)
    stday = Mid(stdate, stvar + 1, sfunc("/", stdate, sfunc("/", stdate) + 1) - stvar - 1)
    If Len(stday) = 1 Then fx = fx + 1
    If Len(stmon) = 2 Then fx = fx + 1
    styr = Right(stdate, Len(stdate) - (sfunc("/", stdate) + 1) - stvar + fx)
    stmonf = CInt(stmon)
    stdayf = CInt(stday)
    styrf = CInt(styr)
    If stmonf < 1 Or stmonf > 12 Or stdayf < 1 Or stdayf > 31 Or styrf < 1 Then
        AgeFunc = &quot;Invalid Date&quot;
        Exit Function
    End If


    fx = 0
    endvar = sfunc(&quot;/&quot;, endate)
    endmon = Left(endate, sfunc(&quot;/&quot;, endate) - 1)
    endday = Mid(endate, endvar + 1, sfunc(&quot;/&quot;, endate, sfunc(&quot;/&quot;, endate) + 1) - endvar - 1)
    If Len(endday) = 1 Then fx = fx + 1
    If Len(endmon) = 2 Then fx = fx + 1
    endyr = Right(endate, Len(endate) - (sfunc(&quot;/&quot;, endate) + 1) - endvar + fx)
    endmonf = CInt(endmon)
    enddayf = CInt(endday)
    endyrf = CInt(endyr)
    If endmonf < 1 Or endmonf > 12 Or enddayf < 1 Or enddayf > 31 Or endyrf < 1 Then
        AgeFunc = &quot;Invalid Date&quot;
        Exit Function
    End If


    years = endyrf - styrf
    If stmonf > endmonf Then
        years = years - 1
    End If
If stmonf = endmonf And stdayf > enddayf Then
        years = years - 1
    End If
    If years < 0 Then
        AgeFunc = &quot;Invalid Date&quot;
    Else
        AgeFunc = years
    End If
End Function

Public Function sfunc(x As Variant, y As Variant, Optional z As Variant)
sfunc = Application.WorksheetFunction.Search(x, y, z)
End Function

Sub abc() '使用示例
    Dim startdate, enddate
    startdate = &quot;01/01/1887&quot;
    enddate = &quot;02/02/1945&quot;
    af = AgeFunc(startdate, enddate)
End Sub

终南之巅

大哥，你这是求助还是分享还是炫技还是保存“云盘”啊？友情提示一下，代码即使再优秀，一个字的注释也没有，后期看起来也费劲，倒不如重新敲。

碧蓝海天

做笔记以备份

林华帅

1900以前的日期，都设置不了格式吧？EXCEL只能到1900