VB/VBA/VBScript根据出生日期计算年龄函数ComputeAge |
您所在的位置：网站首页 › 出生年月多少岁怎么算 › VB/VBA/VBScript根据出生日期计算年龄函数ComputeAge |
|
提醒：本页面将不再更新、维护或者支持，文章、评论所叙述内容存在时效性，涉及技术细节或者软件使用方面不保证能够完全有效可操作，请谨慎参考！ 有时需要处理一些Excel，这些Excel规定的日期格式是类似2012.02.26这样的形式，当我用到VBA或者VBScript处理这些日期时就很难识别并转换类似的日期格式。一般做法都是通过Split按点对其进行拆分。如果要求计算精确到年的话还好办，直接拿今年的年去减出生年就可以了，比如出生日期是1976.01，那么直接用今年2012 - 1976就得出按年算的年龄，有时可能会要求苛刻一点，比如说要求精确到月，呵呵，再Split，再判断，颇显麻烦，今天终于静下心来搞个统一的函数ComputeAge来处理这些问题，当然要能够识别我目前遇到的形如1972.01、1972.01.02、1972.1.2、72.01、72.01.02、19720102、197201日期格式，计算年龄嘛，我就让这个函数支持精确到日吧（可能用不上）。 单单是计算年龄，可能还不能满足我的胃口，当要统计类似1986年前出生的人的时候，我还要将1986转换一次，感觉麻烦，于是给ComputeAge添加了个比较时间的功能，比较的结果按照标准的-1、0、1进行返回。 比较特别的是这个函数还有个附加的功能就是把形如1972.01、1972.01.02、1972.1.2、72.01、72.01.02、19720102、197201日期格式转换为标准的脚本内置日期变量Date，好啦，说了这么多，函数在这里，用法注释已经写得详细了： ' *************************************************** ' * ' * Description: 计算年龄 ' * Author: wangye ' * Website: http://wangye.org ' * ' * Paramters: ' * ByVal datetime 出生日期或者要比较的日期1 ' * ByVal curdatetime 要计算的间隔日期或者要比较的日期2 ' * ByVal grain 粒度，年龄计算或者日期比较粒度，分为： ' * y 精确到年 ' * m 精确到月 ' * d 精确到日 ' * c 特殊标志，如果指定c， ' * 则表示将datetime转换标准日期变量 ' * ByVal comparetime 指示是计算datetime和curdatetime的间隔年龄 ' * 还是比较这两个时间（为True的时候） ' * 当comparetime为True，那么 ' * datetime > curdatetime 返回 1 ' * datetime = curdatetime 返回 0 ' * datetime < curdatetime 返回 -1 ' * ' * 可选项： ' * curdatetime 默认为Now，计算机当前时间 ' * grain 默认为c，表示转换datetime ' * comparetime 默认为False ' * ' * 返回值： ' * 当comparetime为False时返回由grain粒度控制的datetime和curdatetime ' * 时间间隔年龄，当comparetime为True时返回由grain粒度控制的 ' * datetime和curdatetime的大小-1 0 1（具体参考上面comparetime参数描述） ' * 当grain为c，表示仅转换datetime为脚本能够识别的合法日期变量。 ' * 如果函数不能识别日期或者日期非法则返回vbObjectError+8(-2147221496) ' * ' * 备注： ' * 能够支持的日期格式有类似1972.01、1972.01.02、1972.1.2、72.01、72.01.02 ' * 19720102、197201以及脚本能够控制的Date格式变量，可以通过 ' * IsDate函数判断为True的变量。 ' * ' * 注意事项： ' * 日期不支持7201以及720102这样的格式，对于可能的错误格式 ' * 会尝试按下面标准转换： ' * 761 => 1976.01 1976013 => 1976.01.03 ' * 对于省略的月或者日，将按照1月或者1日看待，即1976将转换为1976-01-01 ' * 1976.02将转换为1976.02.01 ' * ' *************************************************** Function ComputeAge( _ ByVal datetime, _ ByVal curdatetime, _ ByVal grain, _ ByVal comparetime) ComputeAge = vbObjectError+8 Dim y,m,d,a datetime = Trim(datetime) If InStr(datetime, ".")>0 Then a = Split(datetime, ".") If UBound(a)=1 Then y = Trim(a(0)) m = Trim(a(1)) ElseIf UBound(a)=2 Then y = Trim(a(0)) m = Trim(a(1)) d = Trim(a(2)) End If ElseIf IsDate(datetime) Then y = Year(datetime) m = Month(datetime) d = Day(datetime) ElseIf IsNumeric(datetime) Then y = CStr(CLng(datetime)) Else Exit Function End If ' Fix long integer time format Select Case Len(y) Case 2 y = "19" & y Case 3 ' Possible incorrect format ' 761 => 1976.01 m = Right(y, 1) y = "19" & Left(y, 1) Case 4 ' Nothing to do Case 5 ' Possible incorrect format ' 19761 => 1976.01 m = Right(y, 1) y = Left(y, 4) Case 6 ' 197601 => 1976.01 m = Right(y, 2) y = Left(y, 4) Case 7 ' Possible incorrect format ' 1976013 => 1976.01.03 m = Mid(y, 5, 2) d = Right(y, 1) y = Left(y, 4) Case 8 ' 19760103 => 1976.01.03 m = Mid(y, 5, 2) d = Right(y, 2) y = Left(y, 4) Case Else Exit Function End Select If m="" Then m=1 If d="" Then d=1 y = CInt(y) m = CInt(m) d = CInt(d) If m12 Then Exit Function End If If d31 Then Exit Function End If datetime = y & "-" & Right("00" & m, 2) & _ "-" & Right("00" & d, 2) If Not IsDate(datetime) Then Exit Function datetime = CDate(datetime) If VarType(grain)vbString And _ (Not IsNumeric(grain)) Then grain="c" If LCase(grain)="c" Then _ ComputeAge = datetime : Exit Function If VarType(curdatetime)=vbError Or _ VarType(curdatetime)=vbEmpty Or _ VarType(curdatetime)=vbNull Then curdatetime = Now() Else curdatetime = ComputeAge(curdatetime,,,False) End If If VarType(comparetime)vbBoolean Then _ comparetime = False If Not IsDate(curdatetime) Then Exit Function curdatetime = CDate(curdatetime) If Not comparetime Then Select Case LCase(CStr(grain)) Case "y","0" ComputeAge = DateDiff("yyyy", datetime, curdatetime) Case "m","1" ComputeAge = Int(DateDiff("m", datetime, curdatetime) / 12) Case "d","2" ComputeAge = Int(DateDiff("m", datetime, curdatetime) / 12) If m=Month(curdatetime) And d>Day(curdatetime) Then _ ComputeAge = ComputeAge-1 End Select Else Select Case LCase(CStr(grain)) Case "y","0" grain = "yyyy" Case "m","1" grain = "m" Case "d","2" grain = "d" End Select a = DateDiff(grain, curdatetime, datetime) If a>0 Then ComputeAge = 1 ElseIf a |
今日新闻 |
推荐新闻 |
| CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3 |