贷款计算器的VBA实现代码

来源：互联网发布：熊猫tv客户端mac版编辑：程序博客网时间：2024/04/27 18:01

Dim MonthPrincipal_EP As Double
Dim MonthInterest_EP(360) As Double
Dim MonthPrincipalLeft_EP(360) As Double
Dim MonthInterestSum_EP(360) As Double

Dim MonthPrincipal_EI(360) As Double
Dim MonthInterest_EI(360) As Double
Dim MonthPrincipalLeft_EI(360) As Double
Dim MonthInterestSum_EI(360) As Double

Dim PrincipalSum As Double
Dim Months As Double
Dim Rate As Double

Dim EI_Each_Month As Double

Const PrincipalCol_EP As Integer = 2
Const InterestCol_EP As Integer = 3
Const PrincipalLeftCol_EP As Integer = 4
Const InterestSumCol_EP As Integer = 5

Const PrincipalCol_EI As Integer = 9
Const InterestCol_EI As Integer = 10
Const PrincipalLeftCol_EI As Integer = 11
Const InterestSumCol_EI As Integer = 12

Const PrimcipalSumCol As Integer = 18
Const PrimcipalSumRow As Integer = 6

Const PrincipalRowStart As Integer = 3

Private Sub CommandButton1_Click() ' main

    PrincipalSum = Worksheets("Sheet1").Cells(PrimcipalSumRow, PrimcipalSumCol).Value

    Months = Worksheets("Sheet1").Cells(PrimcipalSumRow + 1, PrimcipalSumCol).Value * 12

    Rate = Worksheets("Sheet1").Cells(PrimcipalSumRow + 2, PrimcipalSumCol).Value

    'PrincipalSum = 394000

    'Months = 360

    Rate = Rate / 12

    Call Clear

    Call CalcEP

    Call CalcEPI

    Call Refresh

End Sub

Private Sub CalcEP()

MonthPrincipal_EP = PrincipalSum / Months

    MonthPrincipalLeft_EP(1) = PrincipalSum - MonthPrincipal_EP

    MonthInterest_EP(1) = PrincipalSum * Rate

    MonthInterestSum_EP(1) = MonthInterest_EP(1)

    For i = 2 To 360
        MonthInterest_EP(i) = PrincipalSum / Months * (Months - i + 1) * Rate

        MonthPrincipalLeft_EP(i) = PrincipalSum / Months * (Months - i)

        MonthInterestSum_EP(i) = GetSum(MonthInterest_EP, 1, i)
    Next

End Sub

Private Sub CalcEPI()

EI_Each_Month = GetEIForEachMonth

    MonthInterest_EI(1) = PrincipalSum * Rate

    MonthPrincipal_EI(1) = EI_Each_Month - MonthInterest_EI(1)

    MonthInterestSum_EI(1) = MonthInterest_EI(1)

    MonthPrincipalLeft_EI(1) = PrincipalSum - MonthPrincipal_EI(1)

    For i = 2 To Months

        MonthInterest_EI(i) = MonthPrincipalLeft_EI(i - 1) * Rate

        MonthPrincipal_EI(i) = EI_Each_Month - MonthInterest_EI(i)

        MonthPrincipalLeft_EI(i) = MonthPrincipalLeft_EI(i - 1) - MonthPrincipal_EI(i)

        MonthInterestSum_EI(i) = GetSum(MonthInterest_EI, 1, i)

    Next

End Sub

Private Sub Refresh()

    For i = 1 To Months

        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, PrincipalCol_EP).Value = MonthPrincipal_EP
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestCol_EP).Value = MonthInterest_EP(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, PrincipalLeftCol_EP).Value = MonthPrincipalLeft_EP(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EP).Value = MonthInterestSum_EP(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EP + 1).Value = MonthPrincipal_EP + MonthInterest_EP(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EP + 2).Value = PrincipalSum - MonthPrincipalLeft_EP(i)

        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, PrincipalCol_EI).Value = MonthPrincipal_EI(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestCol_EI).Value = MonthInterest_EI(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, PrincipalLeftCol_EI).Value = MonthPrincipalLeft_EI(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EI).Value = MonthInterestSum_EI(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EI + 1).Value = MonthPrincipal_EI(i) + MonthInterest_EI(i)
        Worksheets("Sheet1").Cells(i + PrincipalRowStart - 1, InterestSumCol_EI + 2).Value = PrincipalSum - MonthPrincipalLeft_EI(i)

    Next

End Sub

Private Function GetEIForEachMonth() As Double

    Dim nPower As Double

    nPower = 1

    For i = 1 To Months
        nPower = nPower * (1 + Rate)
    Next

    GetEIForEachMonth = PrincipalSum * Rate * nPower / (nPower - 1)
    'GetEIForEachMonth = 2392.71

End Function

' Get sum of array
Private Function GetSum(ByRef Arr() As Double, ByVal B As Integer, ByVal E As Integer)

    Dim i As Double
    Dim Sum As Double
    Sum = 0
    For i = B To E
        Sum = Sum + Arr(i)
    Next
    GetSum = Sum

End Function

Private Sub Clear()

    For r = 3 To 380

            Worksheets("Sheet1").Cells(r, PrincipalCol_EP).Value = ""
            Worksheets("Sheet1").Cells(r, InterestCol_EP).Value = ""
            Worksheets("Sheet1").Cells(r, PrincipalLeftCol_EP).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EP).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EP + 1).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EP + 2).Value = ""

            Worksheets("Sheet1").Cells(r, PrincipalCol_EI).Value = ""
            Worksheets("Sheet1").Cells(r, InterestCol_EI).Value = ""
            Worksheets("Sheet1").Cells(r, PrincipalLeftCol_EI).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EI).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EI + 1).Value = ""
            Worksheets("Sheet1").Cells(r, InterestSumCol_EI + 2).Value = ""

Next
End Sub