Excel VBA：宏功能，用于根据天数计算收入核销时间表

Question

我正在尝试编写一个宏函数，该函数将根据当月的天数来计算每月的收入。

诀窍是开始日期和结束日期的计算方法，如何放置

输入是

• 交易价值 =总收入
• 交易开始日期
• 交易结束日期
• 期限（以月为单位）
• 每日收益公式为 =（交易值/ 365）/（有效期/ 12）

如果交易在中间开始，则每月计算天数。已确认的总天数收入是起始日期月份中的总天数与月份中的总天数之差。

如果合同在月中结束，则与合同的结束日期相同

示例1

示例2

谢谢 布莱恩

带有两个选项卡的SAMPLE文件，选项卡1具有示例计算。标签2包含我得到的数据，月份是我计算出的数量，并希望使用宏来自动化 Link to Sample excel file

Answer 1

这是非VBA解决方案，请考虑以下因素

1. A列中的交易值
2. B列中的交易开始日期
3. C列中的交易结束日期
4. 以D计的月学期长度
5. 每天的收入公式= E列中的（交易值/ 365）/（有效期长度/ 12）
6. 第1行包含从G1到CX1的月份中的任意一天

，要在G2中输入并从G2复制到CX的公式是

=IF(OR($B2>EOMONTH(G$1,0),$C2<G$1-DAY(G$1)+1),0,IF($C2>EOMONTH(G$1,0),EOMONTH(G$1,0),$C2)-IF($B2>G$1-DAY(G$1)+1,$B2,G$1-DAY(G$1)+1)+1)*$E2

VBA解决方案（尽管不建议使用）是

Sub doCalc()
Dim TCVRng As Range, SdtRng As Range, FdtRng As Range, TermLenRng As Range, MonRng As Range
Dim i As Long
'Modify ranges according to your requirement
Set MonRng = ActiveSheet.Range("G1:CX1")
       For i = 2 To 8
    Set TCVRng = ActiveSheet.Cells(i, 1)
    Set SdtRng = ActiveSheet.Cells(i, 2)
    Set FdtRng = ActiveSheet.Cells(i, 3)
    Set TermLenRng = ActiveSheet.Cells(i, 4)
    'Debug.Print TCVRng.Value, SdtRng.Value, FdtRng.Value
    'Debug.Print "============================================="
    'to bypass any intermidate summaty rowrow
       ' If TCVRng.Value > 0 And IsDate(SdtRng.Value) And IsDate(FdtRng.Value) Then
        MonthCal TCVRng, SdtRng, FdtRng, TermLenRng, MonRng
       ' End If
    Next
End Sub

Private Sub MonthCal(TCVRng As Range, SdtRng As Range, FdtRng As Range, TermLenRng As Range, MonRng As Range)
    Dim TCV As Single, Sdt As Date, Fdt As Date, TermLen As Single, PerDay As Single
    Dim Msdt As Date, Medt As Date, MnAmnt As Single, MnDay As Integer
    Dim Cel As Range, Col As Long, ofst As Long
    TCV = TCVRng.Value
    Sdt = SdtRng.Value
    Fdt = FdtRng.Value

    TermLen = TermLenRng.Value
    PerDay = (TCV / 365) / (TermLen / 12)

        For Each Cel In MonRng
        ofst = Cel.Column - TCVRng.Column
        Msdt = Cel.Value
        Msdt = DateAdd("d", -Day(Msdt) + 1, Msdt)
        Medt = DateAdd("m", 1, Msdt)
        Medt = DateAdd("d", -1, Medt)


        MnDay = IIf(Sdt > Medt Or Fdt < Msdt, 0, IIf(Fdt < Medt, Fdt, Medt) - IIf(Sdt > Msdt, Sdt, Msdt) + 1)
        MnAmnt = MnDay * PerDay
        'Debug.Print TCV, Sdt, Fdt, Msdt, Medt, MnDay, MnAmnt
        TCVRng.Offset(, ofst).Value = MnAmnt
        Next Cel
    End Sub