Question

我有一个现有代码，它是一个产生数组的函数：示例输入：=cellrange(B5,"ytd") [来自B5及以下（或以上）的日期] 示例输出：$B$129:$B$280，这是B列

中今年的完整日期范围

我正在尝试添加名为case的新ttm（过去12个月），但我正在努力寻找合并它的方法。

ttm案例应显示从最近可用日期开始的12个月的收益

Option Explicit

Public Function cellrange(rDates As Range, vFilter As Variant, Optional colOffsetA As Variant, Optional colOffsetB As Variant) As String
'DESCRIPTION:
    'This function takes any cell value in a row and a input: YTD, ALL, or any year (i.e. 2014, 2015) and it finds the range in which the date is situated

    Dim i As Long, ndx1 As Long, ndx2 As Long, r As Range, vA As Variant, bErr As Boolean, bAll As Boolean
    bErr = True
    If IsDate(rDates) Then
        With rDates.EntireColumn
            i = rDates.Parent.Evaluate("count(" & .Address & ")")
            Set r = .Cells(1 - i + rDates.Parent.Evaluate("index(" & .Address & ",match(9.9E+307," & .Address & "))").row).Resize(i, 1)
        End With
        vA = r.Value
        If IsMissing(colOffsetA) And IsMissing(colOffsetB) Then
            colOffsetA = 0: colOffsetB = 0
        End If
        If IsMissing(colOffsetB) = True Then colOffsetB = colOffsetA
        Select Case LCase(vFilter)
            Case "all"
                bErr = 0: bAll = 1
                Set r = r.Range(r.Parent.Cells(1, 1 + colOffsetA), r.Parent.Cells(r.Count, 1 + colOffsetB))
            Case "ytd"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Year(vA(i, 1)) = Year(Date) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case Else 'year
                vFilter = Val(vFilter)
                If vFilter Then
                    For i = 1 To UBound(vA)
                        If ndx1 = 0 And Year(vA(i, 1)) = vFilter Then ndx1 = i
                        If ndx1 And Year(vA(i, 1)) = vFilter Then ndx2 = i
                    Next
                End If
        End Select
        If Not bAll Then If ndx1 > 0 And ndx2 > 0 Then Set r = r.Range(r.Parent.Cells(ndx1, 1 + colOffsetA), r.Parent.Cells(ndx2, 1 + colOffsetB)): bErr = False
        If Not bErr Then cellrange = r.Address Else cellrange = CVErr(xlErrValue)
    Else
        cellrange = CVErr(xlErrValue) 'check if this is the correct error handling
    End If
End Function

Answer 1

这包括＆＃34; ttm＆＃34;情况下：

Public Function cellrange(rDates As Range, vFilter As Variant, Optional colOffsetA As Variant, Optional colOffsetB As Variant) As String
    Dim i As Long, ndx1 As Long, ndx2 As Long, r As Range, vA As Variant, bErr As Boolean, bAll As Boolean
    bErr = True
    If IsDate(rDates) Then
        With rDates.EntireColumn
            i = rDates.Parent.Evaluate("count(" & .Address & ")")
            Set r = .Cells(1 - i + rDates.Parent.Evaluate("index(" & .Address & ",match(9.9E+307," & .Address & "))").row).Resize(i, 1)
        End With
        vA = r.Value
        If IsMissing(colOffsetA) And IsMissing(colOffsetB) Then
            colOffsetA = 0: colOffsetB = 0
        End If
        If IsMissing(colOffsetB) = True Then colOffsetB = colOffsetA
        Select Case LCase(vFilter)
            Case "all"
                bErr = 0: bAll = 1
                Set r = r.Range(r.Parent.Cells(1, 1 + colOffsetA), r.Parent.Cells(r.Count, 1 + colOffsetB))
            Case "ytd"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Year(vA(i, 1)) = Year(Date) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case "ttm"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Date - vA(i, 1) <= (Date - DateSerial(Year(Date) - 1, Month(Date), Day(Date) - 1)) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case Else 'year
                vFilter = Val(vFilter)
                If vFilter Then
                    For i = 1 To UBound(vA)
                        If ndx1 = 0 And Year(vA(i, 1)) = vFilter Then ndx1 = i
                        If ndx1 And Year(vA(i, 1)) = vFilter Then ndx2 = i
                    Next
                End If
        End Select
        If Not bAll Then If ndx1 > 0 And ndx2 > 0 Then Set r = r.Range(r.Parent.Cells(ndx1, 1 + colOffsetA), r.Parent.Cells(ndx2, 1 + colOffsetB)): bErr = False
        If Not bErr Then cellrange = r.Address Else cellrange = CVErr(xlErrValue)
    Else
        cellrange = CVErr(xlErrValue)
    End If
End Function

向VBA代码添加Trailing 12个月的数组功能

1 个答案: