使用VBA实现不同条件下应收租金的计算-部分条件下计算结果异常 - Excel/VBA论坛

问题点数：0 回复次数：6

使用VBA实现不同条件下应收租金的计算-部分条件下计算结果异常

使用BVA编写代码，实现以下功能：三种不同的租赁合同，分别是月结，季结，半年结，月结要求是合同开始后的次月起计算每月应收租金（请注意次月开始第一个月的租金计算应考虑到合同开始日至当月月底的天数问题，比如合同开始日为23年1月11日，那么次月即23年2月开始计算第一个月的租金时应根据月度租金额这个参数，只计算1月11日至1月31日共计21天的租金，第二个月开始的整月就不用考虑天数问题，直接使用给定的参数月合同金额,最后一个月若是整月直接使用月合同金额，若不是于整月，根据实际天数计算），至当年度12月至。季结要求合同开始三个月后的次月计算前三个月的应收租金（请注意第一个月的租金计算应考虑到合同开始日至当月月底的天数问题，第二次计算后三个月租金就不用考虑天数问题，最后三个月若是整月直接使用月合同金额，若不是于整月，根据实际天数计算），以次类推，至当年度12月至。半年结要求合同开始六个月后的次月计算前六个月的应收租金（请注意第一个月的租金计算应考虑到合同开始日至当月月底的天数问题，第二次计算后六个月租金时需考虑最后一个月若是整月直接使用月合同金额，若不是于整月，根据实际天数计算），以次类推，至当年度12月至。以上代码要求是一个自定义函数，函数的参数有五个，分别是合同起始日（日期格式）、合同结束日（日期格式）、第三个参数是结算周期（月结、季结、半年结）、第四个参数是月合同金额，第五个参数是年份，第六个参数是月份（为1-12的月数组成），具体单元选择从哪一行开始，从哪一列开始可自由选择。结合一个实例来说明一下：一份月结合同，第一个参数合同开始日23年1月1日在H5单元格、第二个参数合同结束日23年8月31日在I5单元格、第三个参数结算周期月结在K5单元格、第四个参数月合同金额75000在G5单元格，第五个参数2023在G1单元格，第六个参数当年度的月份区域在L3：W3（L3单元格的值1表示为当年度的1月份，M3单元格的值2表示当年度的2月份，N3单元格的值3表示当年度的3月份，以次类推至到W3单元格的值12表示当年度的12月份），需要在L5：W5区间的单元格中分别计算出当年度1月份应收租金（L5值应为0），当年度2月份应收租金（M5值75000），当年度3月份应收租金（N5值75000），以此类推至到T5单元格对应的当年度9月份应收租金75000，U5：W5单元格无应收租金。
已经使用VBA实现了部分功能，但有部分情况下计算的结果不正确，具体情况是当结算周期为季度时，合同开始日期中的月份大于等于4月时，计算结果为0，结算周期为半年结时，合同开始日期中的年份为以前年度时，计算结果为0，希望能得到各位大神的帮助

图片附件: 游客没有浏览图片的权限，请登录或注册

非住宅项目23年度月度应收款统计 - 副本.rar (27.92 KB)

搜索更多相关主题的帖子: 月份　参数　计算　单元格　天数　

第 2 楼

得分:0

试试看这次是不是你需要的（最后一个不满季/半年/年的租金收取方式有多种理解，程序选择的是满期的次月收取，也可以修改为前一季度收取）：

程序代码：

Option Explicit

'月份序号：公元0年元旦至今的月份序号

Private Sub test()
    Dim startDate As Date, endDate As Date, d As Date, period$, y%, m%, ym&
    startDate = #5/10/2020#
    endDate = #5/9/2022#
    period = "季"
    Debug.Print startDate, endDate, period
    For ym = Date2YM(startDate) To Date2YM(endDate) + 3
        d = YM2Date(ym)
        y = Year(d)
        m = Month(d)
        Debug.Print d, CalculateRent(startDate, endDate, period, 100, y, m)
    Next ym
End Sub

Function CalculateRent(startDate, endDate, period, rentAmt, curYear, curMonth) As Double
    Dim preDate1 As Date, preDate2 As Date, renDate1 As Date, renDate2 As Date
    Dim m&, ym&, n&, i&, j&, k&
    Select Case Left(Trim(period), 1)
        Case "月":      m = 1 '结算周期月份数
        Case "季":      m = 3
        Case "半":      m = 6
        Case "年":      m = 12
    End Select
    i = Date2YM(startDate)          '起租月
    n = Date2YM(endDate)            '止租月
    ym = curYear * 12 + curMonth    '当前月
    k = WorksheetFunction.RoundUp((ym - i) / m, 0)    '当前收租周期序号，0...
    j = (ym - i) Mod m              '本周期内已过月份数
    preDate1 = YM2Date(i + (k - 1) * m)  '本租期开始日
    preDate2 = YM2Date(i + k * m) - 1   '本租期结束日
    renDate1 = IIf(preDate1 > startDate, preDate1, startDate)   '去除起租日前的
    renDate2 = IIf(preDate2 > endDate, endDate, preDate2)       '去除终止日后的
    If (ym > i) And (ym < n + m) And j = 0 Then  '租期内
        CalculateRent = rentAmt * (renDate2 - renDate1) / (preDate2 - preDate1)
    ElseIf ym = n + 1 Then '满期的次月
        CalculateRent = rentAmt * (renDate2 - renDate1) / (preDate2 - preDate1)
    End If
End Function

Private Function Date2YM(d) '日期转换为月份序号
    Date2YM = Year(d) * 12 + Month(d)
End Function

Private Function YM2Date(ym) '月份序号转日期
    YM2Date = DateSerial(ym \ 12, ym Mod 12, 1)
End Function

测试情况

程序代码：

2020/5/10     2022/5/9      月
2020/5/1       0 
2020/6/1       70 
2020/7/1       100 
2020/8/1       100 
2020/9/1       100 
2020/10/1      100 
2020/11/1      100 
2020/12/1      100 
2021/1/1       100 
2021/2/1       100 
2021/3/1       100 
2021/4/1       100 
2021/5/1       100 
2021/6/1       100 
2021/7/1       100 
2021/8/1       100 
2021/9/1       100 
2021/10/1      100 
2021/11/1      100 
2021/12/1      100 
2022/1/1       100 
2022/2/1       100 
2022/3/1       100 
2022/4/1       100 
2022/5/1       100 
2022/6/1       26.6666666666667 
2022/7/1       0 
2022/8/1       0 
2020/5/10     2022/5/9      季
2020/5/1       0 
2020/6/1       90.1098901098901 
2020/7/1       90.1098901098901 
2020/8/1       90.1098901098901 
2020/9/1       100 
2020/10/1      100 
2020/11/1      100 
2020/12/1      100 
2021/1/1       100 
2021/2/1       100 
2021/3/1       100 
2021/4/1       100 
2021/5/1       100 
2021/6/1       100 
2021/7/1       100 
2021/8/1       100 
2021/9/1       100 
2021/10/1      100 
2021/11/1      100 
2021/12/1      100 
2022/1/1       100 
2022/2/1       100 
2022/3/1       100 
2022/4/1       100 
2022/5/1       100 
2022/6/1       8.79120879120879 
2022/7/1       8.79120879120879 
2022/8/1       0 
2020/5/10     2022/5/9      月
2020/5/1       0 
2020/6/1       70 
2020/7/1       100 
2020/8/1       100 
2020/9/1       100 
2020/10/1      100 
2020/11/1      100 
2020/12/1      100 
2021/1/1       100 
2021/2/1       100 
2021/3/1       100 
2021/4/1       100 
2021/5/1       100 
2021/6/1       100 
2021/7/1       100 
2021/8/1       100 
2021/9/1       100 
2021/10/1      100 
2021/11/1      100 
2021/12/1      100 
2022/1/1       100 
2022/2/1       100 
2022/3/1       100 
2022/4/1       100 
2022/5/1       100 
2022/6/1       26.6666666666667 
2022/7/1       0 
2022/8/1       0 
2020/5/10     2022/5/9      季
2020/5/1       0 
2020/6/1       0 
2020/7/1       0 
2020/8/1       90.1098901098901 
2020/9/1       0 
2020/10/1      0 
2020/11/1      100 
2020/12/1      0 
2021/1/1       0 
2021/2/1       100 
2021/3/1       0 
2021/4/1       0 
2021/5/1       100 
2021/6/1       0 
2021/7/1       0 
2021/8/1       100 
2021/9/1       0 
2021/10/1      0 
2021/11/1      100 
2021/12/1      0 
2022/1/1       0 
2022/2/1       100 
2022/3/1       0 
2022/4/1       0 
2022/5/1       100 
2022/6/1       8.79120879120879 
2022/7/1       0 
2022/8/1       0 
2020/5/10     2022/5/9      半年
2020/5/1       0 
2020/6/1       0 
2020/7/1       0 
2020/8/1       0 
2020/9/1       0 
2020/10/1      0 
2020/11/1      95.0819672131148 
2020/12/1      0 
2021/1/1       0 
2021/2/1       0 
2021/3/1       0 
2021/4/1       0 
2021/5/1       100 
2021/6/1       0 
2021/7/1       0 
2021/8/1       0 
2021/9/1       0 
2021/10/1      0 
2021/11/1      100 
2021/12/1      0 
2022/1/1       0 
2022/2/1       0 
2022/3/1       0 
2022/4/1       0 
2022/5/1       100 
2022/6/1       4.37158469945355 
2022/7/1       0 
2022/8/1       0 
2020/5/10     2022/5/9      年
2020/5/1       0 
2020/6/1       0 
2020/7/1       0 
2020/8/1       0 
2020/9/1       0 
2020/10/1      0 
2020/11/1      0 
2020/12/1      0 
2021/1/1       0 
2021/2/1       0 
2021/3/1       0 
2021/4/1       0 
2021/5/1       97.5274725274725 
2021/6/1       0 
2021/7/1       0 
2021/8/1       0 
2021/9/1       0 
2021/10/1      0 
2021/11/1      0 
2021/12/1      0 
2022/1/1       0 
2022/2/1       0 
2022/3/1       0 
2022/4/1       0 
2022/5/1       100 
2022/6/1       2.1978021978022 
2022/7/1       0 
2022/8/1       0

模板1.1.rar (90.75 KB)

第 3 楼

得分:0

上面的测试数据多复制了错误的内容，吓我一跳，重新打开附件测试了季度是正确的：

程序代码：

2020/5/10     2022/5/9      季
2020/5/1       0 
2020/6/1       0 
2020/7/1       0 
2020/8/1       90.1098901098901 
2020/9/1       0 
2020/10/1      0 
2020/11/1      100 
2020/12/1      0 
2021/1/1       0 
2021/2/1       100 
2021/3/1       0 
2021/4/1       0 
2021/5/1       100 
2021/6/1       0 
2021/7/1       0 
2021/8/1       100 
2021/9/1       0 
2021/10/1      0 
2021/11/1      100 
2021/12/1      0 
2022/1/1       0 
2022/2/1       100 
2022/3/1       0 
2022/4/1       0 
2022/5/1       100 
2022/6/1       8.79120879120879 
2022/7/1       0 
2022/8/1       0

第 4 楼

得分:0

如果最后的半期租金在最后一次一并收取，例如：

程序代码：

2020/5/10     2022/5/9      月
2020/5/1       0 
2020/6/1       70 
2020/7/1       100 
2020/8/1       100 
2020/9/1       100 
2020/10/1      100 
2020/11/1      100 
2020/12/1      100 
2021/1/1       100 
2021/2/1       100 
2021/3/1       100 
2021/4/1       100 
2021/5/1       100 
2021/6/1       100 
2021/7/1       100 
2021/8/1       100 
2021/9/1       100 
2021/10/1      100 
2021/11/1      100 
2021/12/1      100 
2022/1/1       100 
2022/2/1       100 
2022/3/1       100 
2022/4/1       100 
2022/5/1       131.034482758621 
2022/6/1       0 
2022/7/1       0 
2022/8/1       0 
2020/5/10     2022/5/9      季度
2020/5/1       0 
2020/6/1       0 
2020/7/1       0 
2020/8/1       90.1098901098901 
2020/9/1       0 
2020/10/1      0 
2020/11/1      100 
2020/12/1      0 
2021/1/1       0 
2021/2/1       100 
2021/3/1       0 
2021/4/1       0 
2021/5/1       100 
2021/6/1       0 
2021/7/1       0 
2021/8/1       100 
2021/9/1       0 
2021/10/1      0 
2021/11/1      100 
2021/12/1      0 
2022/1/1       0 
2022/2/1       100 
2022/3/1       0 
2022/4/1       0 
2022/5/1       110.227272727273 
2022/6/1       0 
2022/7/1       0 
2022/8/1       0

那么代码是：

程序代码：

Option Explicit

'月份序号：公元0年元旦至今的月份序号

Private Sub test()
    Dim startDate As Date, endDate As Date, d As Date, period$, y%, m%, ym&
    startDate = #5/10/2020#
    endDate = #5/9/2022#
    period = "季度"
    Debug.Print startDate, endDate, period
    For ym = Date2YM(startDate) To Date2YM(endDate) + 3
        d = YM2Date(ym)
        y = Year(d)
        m = Month(d)
        Debug.Print d, CalculateRent(startDate, endDate, period, 100, y, m)
    Next ym
End Sub

Function CalculateRent(startDate, endDate, period, rentAmt, curYear, curMonth) As Double
    Dim preDate1 As Date, preDate2 As Date, renDate1 As Date, renDate2 As Date
    Dim m&, ym&, n&, i&, j&, k&
    Select Case Left(Trim(period), 1)
        Case "月":      m = 1 '结算周期月份数
        Case "季":      m = 3
        Case "半":      m = 6
        Case "年":      m = 12
    End Select
    i = Date2YM(startDate)          '起租月
    n = Date2YM(endDate)            '止租月
    ym = curYear * 12 + curMonth    '当前月
    k = WorksheetFunction.RoundUp((ym - i) / m, 0)    '当前收租周期序号，0...
    j = (ym - i) Mod m              '本周期内已过月份数
    preDate1 = YM2Date(i + (k - 1) * m)  '本租期开始日
    preDate2 = YM2Date(i + k * m) - 1    '本租期结束日
    renDate1 = IIf(preDate1 > startDate, preDate1, startDate)   '去除起租日前的
    renDate2 = IIf(preDate2 > endDate, endDate, preDate2)       '去除终止日后的
    If i + k * m >= n Then renDate2 = endDate    '最后半期一并收取
    If (ym > i) And (ym < n + m) And j = 0 Then  '租期内
        CalculateRent = rentAmt * (renDate2 - renDate1) / (preDate2 - preDate1)
    End If
End Function

Private Function Date2YM(d) '日期转换为月份序号
    Date2YM = Year(d) * 12 + Month(d)
End Function

Private Function YM2Date(ym) '月份序号转日期
    YM2Date = DateSerial(ym \ 12, ym Mod 12, 1)
End Function

第 5 楼

得分:0

CalculateRent = rentAmt * (renDate2 - renDate1) / (preDate2 - preDate1)这里面少了一个月数的参数m,我加了进去，测试了一下不同年份不同月份的条件，问题终于得到了解决。
大神就是大神，没有解决不了的问题，利用VBA解决数学上面的问题，确实体现出大神的水平够牛！

第 6 楼

得分:0

如果租金参数是月租金这里就需要乘以m，如果租金参数是月/季/半年/年租金，这里就不需要再乘以系数，这个看约定。

调试可以使用test过程，一下子测试整个期间的情况，比在表里面改参数能更快的发现问题，也便于跟踪调试。

第 7 楼

得分:0

都是高手啊，学习了，感谢分享你的思路。