第14週EXCEL APP錄製巨集 recording macro

何昱陵學習劉任昌的VBA程式碼

Dim n As Integer
Dim spec As String
Const period As Integer = 4
Const maxerror As Double = 0.0000001
Dim payment(period) As Double '廣域變數 4 維度的陣列
Private Sub CommandButton1_Click()
  Dim a, b, c, f, gap As Double
  Dim loopNumber As Integer
  n = n + 1 '第幾次計算+1
  a = 0     '報酬率0
  b = 1     '報酬率1
  gap = 10
  loopNumber = 10
  payment(0) = TextBox1.Value
  payment(1) = TextBox2.Value
  payment(2) = TextBox3.Value
  payment(3) = TextBox4.Value
  f = npv(a)
  If f = 0 Then
     Label9.Caption = 0
  ElseIf f < 0 Then
     Label9.Caption = "內部報酬率小於 0."
  Else
     Do While gap > mexerror And Abs(f) > maxerror And loopNumber < 100
       loopNumber = loopNumber + 1
       c = (a + b) / 2
       f = npv(c)
       If Abs(f) > maxerror And gap > maxerror Then
          If f > 0 Then
            a = c
          Else
            b = c
            gap = b - a
          End If
        Else
          Label9.Caption = c
       End If
     Loop
  End If
  Label10.Caption = f
  Label11.Caption = loopNumber
  spec = "躉繳$" & payment(0) & ", 第1期$" & payment(1) & ",第2期$" & payment(2) & ",第3期$" & payment(3)
  Cells(n, 1).Value = "第" & n & "次執行"
  Cells(n, 2).Value = "內部報酬率:" & c
  Cells(n, 3).Value = "淨現值:" & f
  Cells(n, 4).Value = "迴圈次數:" & loopNumber
'  Selection.TypeParagraph 'typewriter打字機paragraph段落
End Sub
Private Sub CommandButton2_Click()
  End
End Sub
Function npv(rate) '計算特定折現率rate的淨現值
  Dim y As Double
  Dim j As Integer
  y = -payment(0)
  For j = 1 To period
      y = y + payment(j) / (1 + rate) ^ j
  Next
  npv = y
End Function
Private Sub CommandButton3_Click()
    Cells.Select    '選擇所有儲存格
    Selection.ClearContents    '清除選擇 的內容
'  Selection.WholeStory
'  Selection.Delete
End Sub
Private Sub UserForm_Click()
End Sub