之前文章《Excel·VBA自定义函数计算日期期间费用》是根据每月费用标准、费用起止日期计算期间费用金额,本文是与之相对应的(注意事项相同)
根据费用金额、费用起止日期计算每月费用标准
注意:因保留2位小数,monthcost与datecost反向计算存在一定差额
Function monthcost(cost As Double, startdate As Date, enddate As Date) As Double
'函数定义monthcost(费用金额,费用开始日期,费用结束日期),计算每月费用标准
month_count = DateDiff("m", startdate, enddate) '月差数,整月计算
m = DateSerial(Year(startdate), Month(startdate) + month_count, Day(startdate) - 1) '月差数整月后的日期
date1 = DateSerial(Year(startdate), Month(startdate) + 1, 0) '开始日期当月的结束日期,计算当月天数
date2 = DateSerial(Year(enddate), Month(enddate) + 1, 0) '结束日期当月的结束日期,计算当月天数
date3 = DateSerial(Year(enddate), Month(enddate), 1) '结束日期当月的开始日期
date_count1 = DateDiff("d", startdate, date1) + 1 '开始日期距当月末天数,含当日,开始月费用天数
date_count2 = DateDiff("d", date3, enddate) + 1 '结束日期距当月初天数,含当日,结束月费用天数
date_count3 = DateDiff("d", startdate, enddate) + 1 '开始日期距结束日期天数,含当日,同一月内费用天数
If DateDiff("d", enddate, m) = 0 Then '判断期间是否为整月,闰月不影响
monthcost = Round(cost / month_count, 2)
ElseIf DateDiff("d", date1, date2) = 0 Then '开始日期,结束日期在同一个月,构成期间非整月
monthcost = Round(cost * Day(date1) / date_count3, 2)
Else '开始日期,结束日期不在同一个月,构成期间非整月
month_count1 = Round(date_count1 / Day(date1), 2) '开始日期当月费用天数,折算成月数
month_count2 = Round(date_count2 / Day(date2), 2) '结束日期当月费用天数,折算成月数
month_count3 = DateDiff("m", date1, date2) - 1 '开始日期,结束日期中间间隔整月数量
monthcost = Round(cost / (month_count1 + month_count2 + month_count3), 2)
End If
End Function
Sub monthcost帮助信息()
'运行一次后该帮助信息生效
Dim 函数名称 As String '函数名称
Dim 函数描述 As String '函数描述
Dim 参数个数(3) As String '函数参数描述 数组 个数
函数名称 = "monthcost"
函数描述 = "根据费用金额、费用起止日期计算每月费用标准"
参数个数(0) = "参数1:费用金额,数字格式"
参数个数(1) = "参数2:费用开始日期,日期格式"
参数个数(2) = "参数3:费用结束日期,日期格式"
Call Application.MacroOptions(macro:=函数名称, Description:=函数描述, ArgumentDescriptions:=参数个数)
End Sub