Question

我有一张包含日期和价格的工作表（每天都有价格）。并非日历中的所有日期都存在，所以我不使用工作日功能。

我创建了一个if，它使用IsInArray函数检查我想要的日期是否在DateArray中，我是用第一列创建的。

我正在尝试使用以下公式计算月度年度回报：

(PriceEnd/PriceBegin)^(1/(number of days in the period/365.25))-1

从最后一天（列的底部）开始，我使用DateAdd函数获取一年前的日期（我创建一个if条件以查看它是否存在）。然后我使用公式计算值。

移至前一天（列中的倒数第二天），然后重复此过程。

问题1 当我这样做时，如何组织输出，以便最后一天的最后一次返回（我计算的第一次）是在输出列的末尾？

问题2 考虑到当我靠近顶部时，找到1年前的日期的函数将找不到任何数据。有没有办法直接解释这个问题？

到目前为止我建立的代码：

Sub AnnualizedReturn()

Dim x As Long
Dim lRow As Long, lColumn As Long
Dim LastRow As Long, LastColumn As Long
Dim ws As Worksheet
Dim DateArray() As Variant
Dim FinalDate As Date, FirstDate As Date
Dim dAnRet As Date, dAnRet1 As Date, dAnRet2 As Date, dAnRet3 As Date, dAnRet4 As Date
Dim dAnRetpos As Long
Dim w As Workbook
Dim a As Long

Set w = ThisWorkbook

'find date limits
LastRow = Worksheets("TIME").Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = Worksheets("TIME").Cells(1, Columns.Count).End(xlToLeft).Column

DateArray() = Worksheets("TIME").Range("A1:A" & LastRow).Value

FinalDate = w.Worksheets("TIME").Cells(LastRow, 1)
FirstDate = w.Worksheets("TIME").Cells(2, 1)

'clear the return worksheet and set format for dates
Worksheets("Ret").UsedRange.ClearContents

Worksheets("Ret").Columns(1).NumberFormat = "mm-dd-yyyy;@"

'for each column (index), do all the procedures:
'copy dates to return output
For lRow = 2 To LastRow
    Worksheets("Ret").Cells(lRow, 1) = Worksheets("TIME").Cells(lRow, 1)
Next lRow


For lColumn = 2 To LastColumn
    If Worksheets("TIME").Cells(1, lColumn) <> "" Then
        Worksheets("Ret").Cells(1, lColumn) = Worksheets("TIME").Cells(1, lColumn) & " Ret"

'calculate returns and output **********************
            For a = LastRow To 2 Step -1
            b = Worksheets("TIME").Cells(a, 1)

            dAnRet = DateAdd("yyyy", 1, b)
            dAnRet1 = DateAdd("d", 1, b)
            dAnRet2 = DateAdd("d", 2, b)
            dAnRet3 = DateAdd("d", 3, b)
            dAnRet4 = DateAdd("d", 4, b)

            If IsInArray2(dAnRet, DateArray) <> "-1" Then
                dAnRetpos = IsInArray2(dAnRet, DateArray)
            ElseIf IsInArray2(dAnRet1, DateArray) <> "-1" Then
               dAnRetpos = IsInArray2(dAnRet1, DateArray)
            ElseIf IsInArray2(dAnRet2, DateArray) <> "-1" Then
                dAnRetpos = IsInArray2(dAnRet2, DateArray)
            ElseIf IsInArray2(dAnRet3, DateArray) <> "-1" Then
                dAnRetpos = IsInArray2(dAnRet3, DateArray)
            ElseIf IsInArray2(dAnRet4, DateArray) <> "-1" Then
                dAnRetpos = IsInArray2(dAnRet4, DateArray)
            End If

 'added this part as the pasting procedure to output. This is giving the wrong result, the cell references are not correct, and problem 2 is not yet solved.

'if not enough data
        If dAnRetpos = "-1" Or dAnRetpos = 0 Then
            Worksheets("Ret").Cells(a, lColumn).Value = "Not Enough Data Available"
 'Return
        Else
            Worksheets("Ret").Cells(a, lColumn).Formula = "=('TIME'!" & Col_Letter(lColumn) & a & "/'TIME'!" & Col_Letter(lColumn) & dAnRetpos & ")^(1/((DAYS('TIME'!$A" & a & ",'TIME'!$A" & dAnRetpos & ")/365.25)))-1"

        End If

        Next a

    End If


Next lColumn



End Sub


Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(w.Worksheets("TIME SERIES").Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function


Public Function IsInArray2(DateToBeFound As Date, arr As Variant) As Long
Dim position As Long
'default return value if value not found in array
IsInArray2 = -1

For position = LBound(arr, 1) To UBound(arr, 1)
    If arr(position, 1) = DateToBeFound Then
        IsInArray2 = position
        Exit For
    End If
Next

End Function

任何帮助都将深表感谢。 OBS。此处包含的代码仅包含引用循环部分的部分。我删除了计算部分，以使其更小，更易读。

Answer 1

经过一些反复试验后，我得到了正确的粘贴程序，所以我会在这里发帖以防万一有需要。

这只是我修改的代码的一部分，它正确地粘贴日期（以-1步进行迭代）并在开头记录缺失的数据。

对于缺失的日期，有一个区块会增加另一天（在1年之前的日期），直到找到可行的日期（周末和假日的帐户）。

要添加的代码：

'calculate returns and output **********************
        For a = LastRow To 3 Step -1
            b = Worksheets("TIME").Cells(a, 1)

            c = DateAdd("yyyy", -1, b)

            dAnRet = DateAdd("d", 1, c)
            dAnRet1 = DateAdd("d", 1, dAnRet)
            dAnRet2 = DateAdd("d", 2, dAnRet)
            dAnRet3 = DateAdd("d", 3, dAnRet)
            dAnRet4 = DateAdd("d", 4, dAnRet)

            If dAnRet >= FirstDate Then

                If IsInArray2(dAnRet, DateArray) <> "-1" Then
                    dAnRetPos = IsInArray2(dAnRet, DateArray)
                ElseIf IsInArray2(dAnRet1, DateArray) <> "-1" Then
                    dAnRetPos = IsInArray2(dAnRet1, DateArray)
                ElseIf IsInArray2(dAnRet2, DateArray) <> "-1" Then
                    dAnRetPos = IsInArray2(dAnRet2, DateArray)
                ElseIf IsInArray2(dAnRet3, DateArray) <> "-1" Then
                    dAnRetPos = IsInArray2(dAnRet3, DateArray)
                ElseIf IsInArray2(dAnRet4, DateArray) <> "-1" Then
                    dAnRetPos = IsInArray2(dAnRet4, DateArray)
                End If

'if not enough data
                If dAnRetPos = "-1" Or dAnRetPos = 0 Then
                    Worksheets("Ret").Cells(a, lColumn) = "Not Enough Data Available"
'3Y Return
                Else
                    Worksheets("Ret").Cells(a, lColumn).Formula = "=('TIME'!" & Col_Letter(lColumn) & a & "/'TIME'!" & Col_Letter(lColumn) & dAnRetPos & ")^(1/((DAYS('TIME'!$A" & a & ",'TIME'!$A" & dAnRetPos & ")/365.25)))-1"

                End If

                Else
                    Worksheets("Ret").Cells(a, lColumn) = "Not Enough Data Available"

            End If
        dAnRetPos = 0
        Next a

    End If

Next lColumn

所有新变量都声明为Long。

从VBA中的数据系列结束开始进行计算

1 个答案: