?? module1.bas
字號:
'Jing(6) = 9073.4
'Jing(7) = 63112.6
'Jing(8) = 73878.9
'Jing(9) = 113821.4
'Jing(10) = 100541.9
'Jing(11) = 96639#
'Jing(12) = 122694.4
'Jing(13) = 138143.5
'Jing(14) = 124427#
'Jing(15) = 108939.8
'Jing(16) = 116550.6
'Jing(17) = 112244.4
'Jing(18) = 100188.8
'Jing(19) = 86172.1
'Jing(20) = 70192.2
'Jing(21) = 52566.5
'Jing(22) = 40041.3
'Jing(23) = 26980.8
'Jing(24) = 17987.4
'Jing(25) = 13363.3
'Jing(26) = 9653.8
'Jing(27) = 4661.3
'Jing(28) = 3157.4
N = 9
a = 0#
b = 1#
f0 = 0
For i = 1 To N
f0 = f0 + Jing(i)
Next i
f1 = 0
For i = 1 To N
f1 = f1 + Jing(i) / 2 ^ i
Next i
If f0 < 0 Then
caculFIRR1 = -1
Exit Function
End If
If f1 > 0 Then
caculFIRR1 = 100
Exit Function
End If
'fx = 0
'For I = 1 To N
' fx = fx + Jing(I) / Power(1 + 0.06219, I)
'Next I
'MsgBox Format$(fx, "0.0000")
Do
X = (a + b) / 2#
fx = 0
For i = 1 To N
fx = fx + Jing(i) / ((1 + X) ^ i) 'Power(1 + X, I)
Next i
' MsgBox fx & "as" & x
If fx < 0 Then b = X
If fx > 0 Then a = X
'If fx = 0 Then
' caculFIRR = x
' Exit Function
'End If
Loop Until (Abs(fx) < 0.1)
caculFIRR1 = X * 100#
End Function
Public Function caculFIRR(JingXianJin() As Double, N As Byte) As Double
Dim Jing() As Double
Dim a As Double
Dim b As Double
Dim f0 As Double
Dim f1 As Double
Dim X As Double
Dim i As Integer
Dim fx As Double
Jing() = JingXianJin()
a = 0#
b = 1#
f0 = 0
For i = 1 To N
f0 = f0 + Jing(i)
Next i
f1 = 0
For i = 1 To N
f1 = f1 + Jing(i) / 2 ^ i
Next i
If f0 < 0 Then
caculFIRR = -1
Exit Function
End If
If f1 > 0 Then
caculFIRR = 100
Exit Function
End If
'fx = 0
'For I = 1 To N
' fx = fx + Jing(I) / Power(1 + 0.06219, I)
'Next I
'MsgBox Format$(fx, "0.0000")
Do
X = (a + b) / 2#
fx = 0
For i = 1 To N
fx = fx + Jing(i) / ((1 + X) ^ i) 'Power(1 + X, I)
Next i
' MsgBox fx & "as" & x
If fx < 0 Then b = X
If fx > 0 Then a = X
'If fx = 0 Then
' caculFIRR = x
' Exit Function
'End If
Loop Until (Abs(fx) < 0.1)
caculFIRR = X * 100#
End Function
Public Function FGuanLiFei(ZenYouLiang As Double, ShangPinlv As Double, Youjia As Double, BuChangFeiLv As Double, JuGuliFeiLv As Double)
FGuanLiFei = ZenYouLiang * (ShangPinlv / 100 * Youjia * BuChangFeiLv / 100 + JuGuliFeiLv)
End Function
Public Function FXiaoShouFei(ZenYouLiang As Double, ShangPinlv As Double, Youjia As Double, XiaoShouFeiLv As Double)
FXiaoShouFei = ZenYouLiang * ShangPinlv / 100 * Youjia * XiaoShouFeiLv / 100
End Function
Public Function FPingHengDian2(You() As Double, N As Byte) As Double
Dim You1() As Double
Dim a As Double
Dim b As Double
Dim f0 As Double
Dim f1 As Double
Dim X As Double
Dim i As Integer
Dim fx As Double
You1() = You()
'For I = 1 To N
' MsgBox You1(I)
'Next I
a = -0.99
b = 1#
For i = 1 To N
VarShengCheng(i, 2) = You1(i) * (1 + a)
Next i
CostList1Cacul
f0 = caculFIRR(VarShuiHouJing(), N)
If (f0 > 12) Then
FPingHengDian = -1
For i = 1 To N
VarShengCheng(i, 2) = You1(i)
Next i
CostList1Cacul
Exit Function
End If
For i = 1 To N
VarShengCheng(i, 2) = You1(i) * (1 + b)
Next i
CostList1Cacul
f1 = caculFIRR(VarShuiHouJing(), N)
'MsgBox f1
'Exit Function
If (f1 < 12) Then
FPingHengDian = -2
For i = 1 To N
VarShengCheng(i, 2) = You1(i)
Next i
CostList1Cacul
Exit Function
End If
Do
X = (a + b) / 2#
'MsgBox "x=" & X
For i = 1 To N
VarShengCheng(i, 2) = You1(i) * (1 + X)
Next i
CostList1Cacul
fx = caculFIRR(VarShuiHouJing(), N)
' MsgBox "fx=" & fx
If fx < 12 Then a = X
If fx > 12 Then b = X
Loop Until (Abs(fx - 12) < 0.01)
FPingHengDian2 = X * 100#
'MsgBox FPingHengDian
For i = 1 To N
VarShengCheng(i, 2) = You1(i)
Next i
CostList1Cacul
End Function
Public Function FPingHengDian1(You() As Double, N As Byte) As Double
Dim You1() As Double
Dim a As Double
Dim b As Double
Dim f0 As Double
Dim f1 As Double
Dim X As Double
Dim i As Integer
Dim fx As Double
You1() = You()
'For I = 1 To N
' MsgBox You1(I)
'Next I
a = -0.99
b = 1#
For i = 1 To N
VarShengCheng(i, 3) = You1(i) * (1 + a)
Next i
CostList1Cacul
f0 = caculFIRR(VarShuiHouJing(), N)
If (f0 > 12) Then
FPingHengDian = -1
For i = 1 To N
VarShengCheng(i, 3) = You1(i)
Next i
CostList1Cacul
Exit Function
End If
For i = 1 To N
VarShengCheng(i, 3) = You1(i) * (1 + b)
Next i
CostList1Cacul
f1 = caculFIRR(VarShuiHouJing(), N)
'MsgBox f1
'Exit Function
If (f1 < 12) Then
FPingHengDian = -2
For i = 1 To N
VarShengCheng(i, 3) = You1(i)
Next i
CostList1Cacul
Exit Function
End If
Do
X = (a + b) / 2#
'MsgBox "x=" & X
For i = 1 To N
VarShengCheng(i, 3) = You1(i) * (1 + X)
Next i
CostList1Cacul
fx = caculFIRR(VarShuiHouJing(), N)
' MsgBox "fx=" & fx
If fx < 12 Then a = X
If fx > 12 Then b = X
Loop Until (Abs(fx - 12) < 0.01)
FPingHengDian1 = X * 100#
'MsgBox FPingHengDian
For i = 1 To N
VarShengCheng(i, 3) = You1(i)
Next i
CostList1Cacul
End Function
Public Sub VPRenderHTML(Vp As VSPrinter, sHTML As String)
Const IndentList = 500
Dim Doui#, Douj#, Douk#, l#, c$
Dim lLen#, sOutput$, sFont$, sTag$
Dim iListCounter%
Dim bNeedPara%
With Vp
'----------------------------------------------------
' scan the HTML string for text and tags
lLen = Len(sHTML)
Doui = 1
Do While Doui <= lLen
'----------------------------------------------------
' get current character
c = Mid(sHTML, Doui, 1)
'----------------------------------------------------
' if this is a tag, interpret it
If c = "<" Then
'----------------------------------------------------
' <HTML> : look for <BODY>
If Mid(sHTML, Doui, 5) = "<HTML" Then
Doui = InStr(Doui, sHTML, "<BODY")
If Doui = 0 Then Exit Do
Doui = InStr(Doui, sHTML, ">")
If Doui = 0 Then Exit Do
Doui = Doui + 1
'----------------------------------------------------
' </BODY> : done
ElseIf Mid(sHTML, Doui, 7) = "</BODY>" Then
Exit Do
'----------------------------------------------------
' <TABLE>, </TABLE> : tables
ElseIf Mid(sHTML, Doui, 6) = "<TABLE" Then
If sOutput <> "" Or bNeedPara Then .Paragraph = sOutput
sOutput = ""
bNeedPara = False
Douj = InStr(Doui, sHTML, "</TABLE>")
If Douj = 0 Then
Doui = Doui + 7
Else
sOutput = Mid(sHTML, Doui, Douj - Doui + 8)
VPRenderHTMLTable Vp, sOutput
sOutput = ""
bNeedPara = True
Doui = Douj + 8
End If
'----------------------------------------------------
' <PRE>, </PRE> : preformatted text
ElseIf Mid(sHTML, Doui, 5) = "<PRE>" Then
If sOutput <> "" Or bNeedPara Then .Paragraph = sOutput
bNeedPara = False
Douj = InStr(Doui, sHTML, "</PRE>")
If Douj = 0 Then
Doui = Doui + 5
Else
sOutput = Mid(sHTML, Doui + 5, Douj - Doui - 5)
sFont = .FontName
Douj = .SpaceAfter
l = .LineSpacing
.SpaceAfter = 0
.LineSpacing = 100
.FontName = "Courier New"
.Paragraph = sOutput: sOutput = ""
.FontName = sFont
.SpaceAfter = Douj
.LineSpacing = l
Doui = Douj + 6
End If
'----------------------------------------------------
' <P>, </P> : start/finish paragraph
ElseIf Mid(sHTML, Doui, 2) = "<P" Then
'Debug.Print sHTML
If sOutput <> "" Or bNeedPara Then .Paragraph = sOutput
sOutput = ""
bNeedPara = False
If Mid(sHTML, Doui, 3) = "<P>" Then
Doui = Doui + 3
Else
Douj = InStr(Doui, sHTML, ">")
If Douj = 0 Then Exit Do
sTag = Mid(sHTML, Doui, Douj - Doui + 1)
Dim sTTag$
sTTag = Mid(sHTML, Doui + 2, Douj - Doui - 5)
.FontBold = True
.Paragraph = sTTag 'zw designed
.FontBold = False
If InStr(sTag, "LEFT") > 0 Then .TextAlign = taLeftMiddle
If InStr(sTag, "CENTER") > 0 Then .TextAlign = taCenterTop
If InStr(sTag, "RIGHT") > 0 Then .TextAlign = taRightTop
Doui = Douj + 1
End If
ElseIf Mid(sHTML, Doui, 4) = "</P>" Then
If sOutput <> "" Or bNeedPara Then .Paragraph = sOutput
sOutput = ""
bNeedPara = False
.TextAlign = taLeftTop
Doui = Doui + 4
'----------------------------------------------------
' <UL>, </UL> : unordered lists (handled by <LI> and </LI>)
ElseIf Mid(sHTML, Doui, 4) = "<UL>" Then
iListCounter = -1
Doui = Doui + 4
ElseIf Mid(sHTML, Doui, 5) = "</UL>" Then
iListCounter = -1
Doui = Doui + 5
'----------------------------------------------------
' <OL>, </OL> : ordered lists (handled by <LI> and </LI>)
ElseIf Mid(sHTML, Doui, 4) = "<OL>" Then
iListCounter = 1
Doui = Doui + 4
ElseIf Mid(sHTML, Doui, 5) = "</OL>" Then
iListCounter = -1
Doui = Doui + 5
'----------------------------------------------------
' <LI>, </LI> : list items
ElseIf Mid(sHTML, Doui, 4) = "<LI>" Then
If sOutput <> "" Or bNeedPara Then .Paragraph = sOutput
sOutput = ""
bNeedPara = True
.IndentLeft = .IndentLeft + IndentList
.IndentFirst = -.IndentLeft
.IndentTab = IndentList
If iListCounter > 0 Then
.Text = " " & iListCounter & "." & vbTab
iListCounter = iListCounter + 1
Else
.Text = " ?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -