UDF从工作表中返回“此公式中使用的值是错误的数据类型”,但在从VBA其他子项调用时有效

时间:2019-09-02 16:17:54

标签: excel vba

从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

0 个答案:

没有答案