Excel VBA函数做循环和测试标准

Question

Background information : I am trying to test the future dates to check if they fall on Monday, Wednesday or Saturday. If the dates falls on one of the three criteria, the date is returned into the cell. I managed to get this part down.

Problem : I would like the function to automatically loop for another 45 days instead of only referencing from the first date.

Questions :

• Is there a more efficient way or neater way to write the code?
• Is it possible to perform loop in functions? Is yes, could you show and explain
• What are other possible methods? I am looking at expanding my knowledge, please share :)

Thank you for your time!

Public Function AFPSECONDOFFDAY(NextOffDay As Date) As String
Dim ans As String, dayCount As Integer, n As Integer

n = 2

' This statement returns the date into the cell if it is Monday, Wednesday or Saturday

If Format(NextOffDay + 2, "w", vbMonday) = 1 _
Or Format(NextOffDay + 2, "w", vbMonday) = 3 _
Or Format(NextOffDay + 2, "w", vbMonday) = 6 Then
' would like it to continue for another 45 days instead 
' of stopping after + 2 days
    AFPSECONDOFFDAY = NextOffDay + 2

Else
    'If the date does not meet the criteria, I would like it to _
    skip and do the next date. So that cells will be filled simultaneously.
    AFPSECONDOFFDAY = ""

End If

End Function

Answer 1

I would nest the function in a subprocedure. The below loops through 45 days (NextOffDay included in those 45) and writes each date that falls on a Mon, Wed or Fri to the next open cell in row 1 of the first worksheet in the workbook the code is written in.

Public Function AFPSECONDOFFDAY(NextOffDay As Date) As String
Dim ans As String, dayCount As Integer, n As Integer

n = 2 

' This statement returns the date into the cell if it is Monday, Wednesday     or Saturday

If Format(NextOffDay + 2, "w", vbMonday) = 1 _
Or Format(NextOffDay + 2, "w", vbMonday) = 3 _
Or Format(NextOffDay + 2, "w", vbMonday) = 6 Then
' would like it to continue for another 45 days instead 
' of stopping after + 2 days
    AFPSECONDOFFDAY = NextOffDay + 2

Else
    'If the date does not meet the criteria, I would like it to _
    skip and do the next date. So that cells will be filled simultaneously.
    AFPSECONDOFFDAY = ""

End If

End Function

Sub Func_Loop()
Dim NextOffDay as Date
Dim i as Integer

Call Different_Sub 'You simply write Call and the name of the sub procedure.
                   'If it is in a different module, you must qualify which module
                   'If there is an argument it would be: Call Different_Sub(argument)

NextOffDay = "02/25/2015" 'Change this date to whatever you need, or have a user enter the date through an input box or set it to a certain cell.

For i = 0 to 44
If AFPSECONDOFFDAY(NextOffDay + i) <> "" then
    Thisworkbook.Worksheets(1).Cells(1,columns.count).end(xltoleft).offset(0,1) = AFPSECONDOFFDAY(NextOffDay + i)
End if
Next i
End Sub