贷款计算器的VBA实现代码

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 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值