VB  获取两段日期相交重合的部分

有时候很有用,比如工资结算,承包天数计算、租金计算等等。

一个典型的例子是:

某公司出租某设备,每自然月费用为M元,不足一月按天计费。客户A 于s1时间开始租用该设备,于e1时间停止租用该设备。求,n年m月费用是多少?

解:案例难点在于计算收费设备实际使用的时间, 通过时间线分析可知,实际上就是求使用时间段 和 自然月计费时间段的交集(在该月内使用了多长时间)

即:(s1,e1)(m月首日,m月末日)  集合的交集。

vb 伪代码:

dim d1 as DateArea
dim d2 as DateArea
d1.s=s1
d1.e=e1
d2.s=cdate(#n-m-01#)
d2.e=datedadd(d,-1,DateAdd(m,1,#n-m-01#)


'产生费用时间段
hejishijian=getDateAre(d1,d2)

'产生费用天数
days=datediff(d,hejishijian.e,hejishijian.s) +1
'费用=月费用 / 该月天数 * 产生费用天数
feiyong=m/(datediff(d,d2.e,d2.s)+1) * days


tpye DateArea 
   s as date
   e as date
end type

'getDateArea    获取两段日期相交重合的部分
'DA1            时间段1
'DA2            时间段2
'
Function getDateArea(ByRef da1 As DateArea, ByRef da2 As DateArea) As DateArea
Dim Result As DateArea
Dim tmpTimeLine(4) As Date
'Dim ReaultTimeLine(4) As Date
Dim tmpMindate As Date

If da1.e < da1.s Or da2.e < da2.s Then
Result.s = #1/1/1900#
Result.e = #1/1/1900#
GoTo exitFunction
End If

If da1.e < da2.s Or da1.s > da2.e Then
Result.s = #1/1/1900#
Result.e = #1/1/1900#
Else
tmpTimeLine(0) = da1.s
tmpTimeLine(1) = da1.e
tmpTimeLine(2) = da2.s
tmpTimeLine(3) = da2.e
'Debug.Print "输入:" & tmpTimeLine(0) & "," & tmpTimeLine(1) & "," & tmpTimeLine(2) & "," & tmpTimeLine(3)
For i = 0 To 3 Step 1
  For j = i To 3 Step 1
        If tmpTimeLine(i) > tmpTimeLine(j) Then
         tmpMindate = tmpTimeLine(j)
         tmpTimeLine(j) = tmpTimeLine(i)
         tmpTimeLine(i) = tmpMindate
        End If
  Next j
Next i
    'Debug.Print "输出:" & tmpTimeLine(0) & "," & tmpTimeLine(1) & "," & tmpTimeLine(2) & "," & tmpTimeLine(3)
    Result.s = tmpTimeLine(1)
    Result.e = tmpTimeLine(2)
End If

exitFunction:
getDateArea = Result
End Function