Skip to content

Instantly share code, notes, and snippets.

@wangye
Created February 26, 2012 12:04
Show Gist options
  • Save wangye/1916319 to your computer and use it in GitHub Desktop.
Save wangye/1916319 to your computer and use it in GitHub Desktop.
Compute Age in many ways
Option Explicit
' ***************************************************
' *
' * Description: 计算年龄
' * Author: wangye <pcn88 at hotmail dot com>
' * 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 m<1 Or m>12 Then
Exit Function
End If
If d<1 Or d>31 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<0 Then
ComputeAge = -1
Else
ComputeAge = 0
End If
End If
End Function
WScript.Echo ComputeAge("19570321", Now, "y", False)
WScript.Echo ComputeAge("1957.3.21", Now, "y", False)
WScript.Echo ComputeAge("19570321", "2012", "y", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.01.03", "y", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.01.03", "m", False) ' 54
WScript.Echo ComputeAge("1957.3.21", "2012.03.22", "d", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.03.20", "d", False) ' 54
' Convert date to datetime variable
WScript.Echo ComputeAge("1957.3.21", , "c", False)
' Compare two date time by year, 1957 < 2001 return -1
WScript.Echo ComputeAge("1957.03.21", "2001.01.02", "y", True) ' -1
' Compare two date time by month, 1957.03 > 1957.02 return 1
WScript.Echo ComputeAge("1957.03.21", "1957.02", "m", True) ' 1
' Compare two date time by day, 1957.03.21 = 1957.03.21 return 0
WScript.Echo ComputeAge("1957.03.21", "1957.03.21", "d", True) ' 0
' Error occured "aaa" is not valid date time return vbObjectError+8
WScript.Echo ComputeAge("aaa", Now, "y", False) ' -2147221496
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment