体验零代码搭建

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

网友投稿  ·  2024-01-25 22:01  ·  云表格  ·  阅读 345


一、符合如下的条件

一、符合如下的条件

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

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

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


Excel如何根据条件自动填充颜色 << 上一篇
2024-01-25 22:01
excel之FLOOR函数介绍
2024-01-25 22:01
下一篇 >>

相关推荐