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

Question

I am trying to write a macro function that will calculate revenue per month based on number of days in the month.

The trick is the start date and end date calculation, how to put that

The inputs are

• Deal value = Total revenue
• Deal start date
• Deal end date
• Term length in months
• Rev per day formula is = (Deal value/365)/(Term length/12)

Number of days is calculated per month if deals starts in-between Total days revenue recognized is difference between Total days in start dates month and month total days.

Same with ending days for the contract if contract ends mid month

example 1

Example 2

Thanks Brian

SAMPLE file with two tab, tab 1 has the example calculation. Tab 2 has the data I get and the months are the amount I calculate and want to use a macro to automate Link to Sample excel file

Answer 1

This is a non VBA solution considering the following

1. Deal value in column A
2. Deal start date in Column B
3. Deal end date in Column C
4. Term length in months in D
5. Rev per day formula is = (Deal value/365)/(Term length/12) in Column E
6. Row 1 contain any day of the months form G1 to CX1

and the formula for to be entered in G2 and copied from G2 to CX... is

=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

And the VBA solution (though not suggested) is

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