函数问题：Excel VBA 中的日期过滤器

Question

So, I'm having an issue with making a function that just returns 1 if the date is set in a quarter previous to the actual one. I'm not fluent with functions, so it might be a stupid mistake, but I can't fix it. Thank you kind souls:)

Public Function IsOnQX(ByVal InputCell As Range, ByVal Month As Long) As Integer
    Dim ActualQuarter As String
    Dim PastQuarter As String

        If (Month < 1) Or (Month > 12) Then
                Call Err.Raise(6) ' Value out of Bounds '
        End If

        Set ActualQuarter = ((Month(Now())) + 2) \ 3
        Set PastQuarter = ((Month(InputCell.Value)) + 2) / 3

        If (InputCell.Value = "") Or (PastQuarter < ActualQuarter) Then
            IsOnQX = 1
        Else
            IsOnQX = 0
        End If

End Function

My idea is to use this function as part of a COUNTIFS statement in a Macro that returns the number of items that comply with two conditions: either the cell in the table is empty (returns 1) or the date contained in said cell is from a previous quarter period (=1) again, and just count the 1s to get the total amount.

Something like;

Range("C63")=COUNTIFS(TablaI_R[Project Name], IF(ISNUMBER(SEARCH(TablaI_R[Project Name],AZAR),1,0)=1), TablaI_R[Actual Closed Date], IF(IsOnQX(TablaI_R[Actual Closed Date])=1, 1, 0)=1)

Thanks everyone!

Answer 1

You shouldn't declare String variables when doing simple arithmetic.
Also Set is used for Object type variables.

You could use Let for other variables, but that isn't needed in modern Visual Basic.

Public Function IsOnQX(ByVal InputCell As Range, ByVal Month As Long) As Integer
    Dim ActualQuarter As Integer
    Dim PastQuarter As Integer
    If (Month < 1) Or (Month > 12) Then
            Call Err.Raise(6) ' Value out of Bounds '
    End If

    ActualQuarter = (Month(Date) + 2) \ 3
    PastQuarter = (Month(InputCell.Value) + 2) \ 3
    If IsEmpty(InputCell) Or (PastQuarter < ActualQuarter) Then
        IsOnQX = 1
    Else
        IsOnQX = 0
    End If
End Function

Answer 2

Edit: Updated to return a 1 for a blank cell

Given a date, you can do this with a one-liner:

Function inPrevQx(D As Date) As Long
    inPrevQx = IIf(Abs(DateDiff("m", D, Date)) > 6 And CLng(D) <> 0, 0, Abs(DatePart("q", DateAdd("q", 1, D)) = DatePart("q", DateAdd("q", 0, Date)) Or CLng(D) = 0))
End Function

By examining the formula, and using VBA help to understand the functions, you should be able to figure out the algorithm. Ask if you have any questions.

Edit 2

OP has clarified that he wants a 0 returned for the current quarter, and a 1 returned for any other quarter (or blanks, I assume).

That being the case, the above can be modified to:

Edit 3 (further simplification)

Function notInCurrQx(D As Date)
  notInCurrQx = Abs(DateDiff("q", D, Date) <> 0)
  'or even:  notInCurrQx = -(DateDiff("q", D, Date) <> 0)
End Function