module1.bas

用于三次采油技术的经济评价

'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 = "