Dzwebs.Net

撰写电脑技术杂文十余年

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

Admin | 2011-4-7 8:39:22 | 被阅次数 | 13094

温馨提示!

如果未能解决您的问题,请点击搜索;登陆可复制文章,点击登陆

  一、符合如下的条件  

  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杂文

上一篇:使用RATE函数计算月利率和年利率的方法

下一篇:Excel如何按颜色来查找

网站备案号:

网站备案号:滇ICP备11001339号-7

版权属性:

Copyright 2007-2021-forever Inc. all Rights Reserved.

联系方式:

Email:dzwebs@126.com QQ:83539231 访问统计