首页 > 办公 > Excel > 正文

excel计算年龄准确到几岁几月几天

2024-08-23 19:53:25
字体:
来源:转载
供稿:网友

  一、符合如下的条件

  1岁以上写岁

  1月以上写月,

  不足月写天。

  二、宏代码

  Function GetDateDiff(StartD, EndD)

  Dim y%, m%, d%

  If StartD > EndD Or Not IsDate(StartD) Or Not IsDate(EndD) Then GetDateDiff = "数据有误"

  y = DateDiff("yyyy", StartD, EndD)

  If DateSerial(Year(EndD), Month(StartD), Day(StartD)) > EndD Then

  y = y - 1

  If y >= 1 Then GoTo 100

  m = 12 - Month(StartD) + Month(EndD)

  Else

  m = Month(EndD) - Month(StartD)

  End If

  If Day(EndD) >= Day(StartD) Or Day(EndD) = Day(DateSerial(Year(EndD), Month(EndD) + 1, 0)) Then

  If Day(EndD) >= Day(StartD) Then d = Day(EndD) - Day(StartD)

  If Day(EndD) < Day(StartD) And Day(EndD) = Day(DateSerial(Year(EndD), Month(EndD) + 1, 0)) Then d = Day  (DateSerial(Year(StartD), Month(StartD) + 1, 0)) - Day(StartD)

  Else

  m = m - 1

  d = Day(DateSerial(Year(StartD), Month(StartD) + 1, 0)) - Day(StartD) + Day(EndD)

  End If

  If m >= 1 Then d = 0

  100: GetDateDiff = IIf(y > 0, y & "岁", IIf(m > 0, m & "月", d & "天"))

  End Function

  Sub Get年月日()

  Dim arr1, arr2()

  arr = Sheet1.Range("a2:b" & Sheet1.Range("A65536").End(xlUp).Row)

  ReDim arr2(1 To UBound(arr), 1 To 1)

  For i = 1 To UBound(arr)

  arr2(i, 1) = GetDateDiff(arr(i, 1), arr(i, 2))

  Next i

  Sheet1.Range("C2:c" & Sheet1.Range("A65536").End(xlUp).Row) = arr2

  End Sub

  以上代码是宏代码,在模块中使用。


发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表