Function cqje(ByVal zcqje As Double, ByVal xyqx As Integer, ByRef zlqj As Range, ByRef zlje As Range, ByRef cqqj As Range) As Double
'自定义函数目的:求超期金额
'说明：
'参数一：zcqje 总超期金额
'参数二：xyqx 信用期限
'参数三：zlqj 帐龄期间
'参数四：zlje 帐龄金额
'参数五：cqqj 超期期间
Dim r As Range
Dim i As Integer
Dim myarray1, myarray2
Dim d, mykey
Dim isplit As Integer
Dim je As Double
Set d = CreateObject("scripting.dictionary")
isplit = -1
'获得超期期间与金额
For i = 1 To zlqj.Cells.Count
'如果帐龄金额不为0
If zlje.Cells(i) <> 0 Then
'如果帐龄期间标志为-
If bzh(zlqj.Cells(i)) = True Then
myarray1 = Split(zlqj.Cells(i), "-")
'如果信用期限小于等于帐龄期间的右值
If xyqx <= CInt(myarray1(1)) Then
d.Add CInt(myarray1(1)) - xyqx, zlje.Cells(i)
'记录待分割地点
If isplit = -1 Then
isplit = CInt(myarray1(1)) - xyqx
End If
End If
Else
myarray1 = Split(zlqj.Cells(i), ">")
d.Add CInt(myarray1(1)) + 1, zlje.Cells(i)
End If
End If
Next
'如果isplit的初值被改变，则重赋分割地点的值
If isplit <> -1 Then
d.Item(isplit) = zcqje - (Evaluate(Join(d.items, "+")) - d.Item(isplit))
End If
If bzh(cqqj.Value) = True Then
myarray2 = Split(cqqj.Value, "-")
For Each mykey In d.Keys
If mykey > CInt(myarray2(0)) And mykey <= CInt(myarray2(1)) Then
je = je + d.Item(mykey)
End If
Next
Else
myarray2 = Split(cqqj.Value, ">")
For Each mykey In d.Keys
If mykey > CInt(myarray2(1)) Then
je = je + d.Item(mykey)
End If
Next
End If
cqje = je
End Function
Function bzh(str As String) As Boolean
'判断不同的期间标志，即含-或>
bzh = Len(str) > Len(Replace(str, "-", ""))
End Function作者: jjqlucky 时间: 2008-6-14 16:02
看一下!作者: 刘志文 时间: 2008-12-15 16:15
学习一下!![:50] [:50]