从VBA中的子函数或其他函数调用时,我有一个可以正常工作的函数,但是当我尝试从工作表中调用它时,出现错误。
在其他VBA子行中:
SimulationOfInvestmentPlan(0.25, DateSerial(2006, 1, 2), DateSerial(2012, 1, 3), 3, 0.25, 0.009, 1.4)
返回具有预期数据的数组,但在工作表中该行:
SimulationOfInvestmentPlan(0.25, Date(2006, 1, 2), Date(2012, 1, 3), 3, 0.25, 0.009, 1.4)
我得到#value,并在警告符号中显示一条消息“此公式中使用的值是错误的数据类型”。
很抱歉,冗长的代码,我只是不知道问题可能在哪一部分。
代码如下:
Dim dStartCash As Double, dCash As Double, dHeldContract As Double, sHeldContractSym As String
Dim dRealizedP As Double, dLastYearP As Double
Dim dDivSum As Double, dInterestSum As Double, dSumComission As Double
Dim iETFUnits As Integer, dETFValue As Double, dETFCostBase As Double, dContractCostBase As Double, dTaxPaid As Double
Dim rMarketData As Range
Dim aMarketData(), aDatesMarketData(), aResultsH(), aResultsD() As Variant
Dim iContractMul As Integer
Dim iRow As Integer, i As Integer
Dim temp As Variant
Const iDateCol = 1, iCurrentConSymCol = 2, iCurrentConPriceCol = 3, iNexConSymCol = 4, iNexConPriceCol = 5, iDFFCol = 14, iETFPriceCol = 15, iDivCol = 16
Public Function SimulationOfInvestmentPlan(dTaxRate As Double, lDateStart As Long, lDateEnd As Long, dContractComis As Double, dContractSpred As Double, dETFComis As Double, dMinComisETF As Double) As Variant()
Dim wResults As Variant
Dim rResults As Range
Set rMarketData = Worksheets("merged_data").Range("A1").CurrentRegion
aMarketData = rMarketData.Value2
aDatesMarketData = rMarketData.Range("A1").EntireColumn.Value2
iRow = WorksheetFunction.Match(lDateStart, aDatesMarketData, 0)
'starts from a date that there is market data
Do While aMarketData(iRow, iCurrentConPriceCol) = 0
iRow = iRow - 1
Loop
iContractMul = 50
dStartCash = aMarketData(iRow, iCurrentConPriceCol) * iContractMul / (1 / (1 - dTaxRate))
dCash = dStartCash
dHeldContract = aMarketData(iRow, iCurrentConPriceCol) * iContractMul
sHeldContractSym = aMarketData(iRow, iCurrentConSymCol)
dCash = dCash - dContractComis
dSumComission = dContractComis
dContractCostBase = dHeldContract + dContractComis + dContractSpred * iContractMul
dCash = dCash - dContractSpred * iContractMul
Call BalanceETF(iRow, 0.02, dMinComisETF, dETFComis)
Do While iRow > 1 And aMarketData(iRow, iDateCol) < lDateEnd
i = 0
'MTM settel
If aMarketData(iRow, iCurrentConSymCol) = sHeldContractSym Then
dCash = dCash + aMarketData(iRow, iCurrentConPriceCol) * iContractMul - dHeldContract
dHeldContract = aMarketData(iRow, iCurrentConPriceCol) * iContractMul
ElseIf aMarketData(iRow, iNexConSymCol) = sHeldContractSym Then
dCash = dCash + aMarketData(iRow, iNexConPriceCol) * iContractMul - dHeldContract
dHeldContract = aMarketData(iRow, iNexConPriceCol) * iContractMul
End If
If dCash < 0 Then
dCash = dCash + Round(dCash * aMarketData(iRow, iDFFCol) / 100 / 360, 4)
dInterestSum = dInterestSum + Round((dCash * aMarketData(iRow, iDFFCol) / 100 / 360) * -1, 4)
End If
dCash = dCash + aMarketData(iRow, iDivCol) * iETFUnits
dRealizedP = dRealizedP + aMarketData(iRow, iDivCol) * iETFUnits
dDivSum = dDivSum + aMarketData(iRow, iDivCol) * iETFUnits
'check for MC
If IsNumeric(aMarketData(iRow, iETFPriceCol)) And aMarketData(iRow, iETFPriceCol) <> 0 Then dETFValue = iETFUnits * aMarketData(iRow, iETFPriceCol)
If dCash + dETFValue < dHeldContract * 0.05 Then
MsgBox ("You have MC on " + Format(aMarketData(iRow, iDateCol), "Short Date"))
Exit Function
End If
'Roll contract on 10th of the last month trading. Traiding month are: 3,6,9,12
If Day(aMarketData(iRow, iDateCol)) = 10 And Month(aMarketData(iRow, iDateCol)) Mod 3 = 0 Then
Do While aMarketData(iRow - i, iCurrentConPriceCol) = 0
i = i + 1
Loop
'If i>0 than we need to MTM the old contract firs, becouse we didn't do it before.
If i > 0 Then
dCash = dCash + aMarketData(iRow - i, iCurrentConPriceCol) * iContractMul - dHeldContract
dHeldContract = aMarketData(iRow - i, iCurrentConPriceCol) * iContractMul
End If
dRealizedP = dRealizedP + dHeldContract - dContractCostBase
dSumComission = dSumComission + dContractComis * 2
dCash = dCash - dContractComis * 2
dRealizedP = dRealizedP - dContractComis
dCash = dCash - dContractSpred * 2 * iContractMul
dRealizedP = dRealizedP - dContractSpred * iContractMul
dHeldContract = aMarketData(iRow - i, iNexConPriceCol) * iContractMul
sHeldContractSym = aMarketData(iRow - i, iNexConSymCol)
dContractCostBase = dHeldContract + dContractComis + dContractSpred * iContractMul
Call BalanceETF(iRow - i, 0.02, dMinComisETF, dETFComis)
End If
If Day(aMarketData(iRow, iDateCol)) = 31 And Month(aMarketData(iRow, iDateCol)) = 12 Then
If dRealizedP > 0 Then
dLastYearP = dRealizedP
dRealizedP = 0
Else: dLastYearP = 0
End If
End If
If Day(aMarketData(iRow, iDateCol)) = 30 And Month(aMarketData(iRow, iDateCol)) = 3 Then
dCash = dCash - dLastYearP * dTaxRate
dTaxPaid = dTaxPaid + dLastYearP * dTaxRate
dLastYearP = 0
End If
iRow = iRow - 1
Loop
'Close all positions.
If iRow < 2 Then iRow = 2
Do While aMarketData(iRow, iETFPriceCol) = "" Or aMarketData(iRow, iETFPriceCol) = 0
iRow = iRow + 1
Loop
Call BalanceETF(iRow, 5, dMinComisETF, dETFComis)
dCash = dCash - dContractComis
dSumComission = dSumComission + dContractComis
dRealizedP = dRealizedP - dContractComis
dCash = dCash - dContractSpred * iContractMul
dRealizedP = dRealizedP - dContractSpred * iContractMul
dRealizedP = dRealizedP + dHeldContract - dContractCostBase
If dRealizedP > 0 Then
dCash = dCash - dRealizedP * dTaxRate
dTaxPaid = dTaxPaid + dRealizedP * dTaxRate
dRealizedP = 0
End If
ReDim aResultsD(1 To 12)
aResultsD(1) = Format(lDateStart, "Short Date")
aResultsD(2) = Format(aMarketData(iRow, iDateCol), "Short Date")
aResultsD(3) = Format(dStartCash, "currency")
aResultsD(4) = Format(dCash, "currency")
aResultsD(5) = Format(dCash - dStartCash, "currency")
aResultsD(6) = Format(dCash / dStartCash - 1, "percent")
aResultsD(7) = Format(WorksheetFunction.Rri((aMarketData(iRow, iDateCol) - lDateStart) / 365, dStartCash, dCash), "percent")
aResultsD(8) = Format(dTaxPaid, "currency")
aResultsD(9) = Format(dDivSum, "currency")
aResultsD(10) = Format(dSumComission, "currency")
aResultsD(11) = Format(dRealizedP, "currency")
aResultsD(12) = Format(dInterestSum, "currency")
SimulationOfInvestmentPlan = aResultsD
End Function
Private Sub BalanceETF(iCurrentRow As Integer, dPeOfProtfolio As Double, dMinComisETF As Double, dETFComis As Double)
With WorksheetFunction
If dCash > (dPeOfProtfolio + 0.01) * dHeldContract Then
temp = (dCash - dPeOfProtfolio * dHeldContract) \ aMarketData(iCurrentRow, iETFPriceCol)
iETFUnits = iETFUnits + temp
dCash = dCash - temp * aMarketData(iCurrentRow, iETFPriceCol)
dETFCostBase = dETFCostBase + temp * aMarketData(iCurrentRow, iETFPriceCol)
dCash = dCash - .Max(dMinComisETF, dETFComis * temp)
dSumComission = dSumComission + .Max(dMinComisETF, dETFComis * temp)
dETFCostBase = dETFCostBase + .Max(dMinComisETF, dETFComis * temp)
ElseIf dCash < (dPeOfProtfolio - 0.01) * dHeldContract Then
temp = .Min((dPeOfProtfolio * dHeldContract - dCash) \ aMarketData(iCurrentRow, iETFPriceCol), iETFUnits)
dRealizedP = dRealizedP + temp * aMarketData(iCurrentRow, iETFPriceCol) - dETFCostBase / iETFUnits * temp
dETFCostBase = dETFCostBase - dETFCostBase / iETFUnits * temp
iETFUnits = iETFUnits - temp
dCash = dCash + temp * aMarketData(iCurrentRow, iETFPriceCol)
dCash = dCash - .Max(dMinComisETF, dETFComis * temp)
dSumComission = dSumComission + .Max(dMinComisETF, dETFComis * temp)
dRealizedP = dRealizedP - .Max(dMinComisETF, dETFComis * temp)
End If
End With
End Sub