为VBA代码添加尾随的十二个月数组function
我有一个现有的代码是一个函数，产生一个数组：示例input： =cellrange(B5,"ytd") [从B5和以下（或以上）有date]示例输出： $B$129:$B$280这是今年B列的全date范围
我正在尝试添加一个名为ttm （ ttm十二个月）的新case ，但是我正在努力寻找一种合并它的方法。
ttm案件应该显示从最近的可用date起的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 (ie 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
这包括“ttm”情况：
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