2016-12-24 53 views
-1

我希望在給定範圍時打印截止日期的代碼。給出截止日期並給出範圍的月份的打印截止日期

例如,如果到期日是每個月的第一天,我給出的範圍是5/1/12和5/23/16,那麼我想要的答案應該是6/1/12,7/1/12,8/1/12,9/1/12至5/1/16,格式應爲mmddyyyy

+0

類似於= date(1,month(A1)+ 1,year(A1)) –

回答

0

您沒有指定要使用此程序的程序,或者您希望如何激活它,所以我只是假設您使用Microsoft Excel或Microsoft Access,因爲您在VBA中需要它。我將它寫爲一個函數,可以在Excel公式或Access查詢或未綁定的文本框中使用。我也確信一個更優雅的解決方案是可能的,但從我做的測試來看,這是可行的。

Here is an example of use in Excel

這裏是代碼的功能列表:

Option Explicit 


Public Function GetNextDueDate(DateRangeBegin As Date, DateRangeEnd As Date, DayDue As Byte) As Variant 
    ' •Purpose• 
    '  Given a date range, and a day of the month as a due date, return the first due date that is 
    '  after the beginning of the date range and today, and on or before the end of the date range. 
    ' 
    ' •Comments• 
    '  There is a fair amount of data validation necessary to ensure the return of the proper due date. 
    '  The function currently returns a text string representing an error when there is a problem with 
    '  finding a valid due date. You may wish to change this to use the Err.Raise method if you want 
    '  the code engine to actually generate an error. 

    Dim TempDueDate As Date 

    On Error GoTo HandleErr_GetNextDueDate 

    'Check that date range is valid (i.e. begin date is not after end date). 
    If DateRangeBegin > DateRangeEnd Then 
     'Return error text. 
     GetNextDueDate = "#ERROR_INVALID_DATE_RANGE" 
    Else 
     'Determine today's relation to the given date range. 
     Select Case Date 
      Case Is <= DateRangeBegin 
       'Date range begins today or is in the future. Verify that DayDue falls after DateRangeBegin and on or before DateRangeEnd. 
       TempDueDate = DateSerial(Year(DateRangeBegin), Month(DateRangeBegin), DayDue) 
       If TempDueDate > DateRangeBegin Then 
        If TempDueDate <= DateRangeEnd Then 
         'Day due falls within the specified range. 
         GetNextDueDate = TempDueDate 
        Else 
         'There is no valid due date within the given date range. 
         GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
        End If 
       Else 
        'Day due for the same month as DateRangeBegin falls before DateRangeBegin. Check for the following month. 
        TempDueDate = DateSerial(Year(DateRangeBegin), Month(DateRangeBegin) + 1, DayDue) 
        If TempDueDate <= DateRangeEnd Then 
         'Day due falls within the specified range . 
         GetNextDueDate = TempDueDate 
        Else 
         'There is no valid due date within the given date range. 
         GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
        End If 
       End If 
      Case Else 
       'Date range has already begun, or is in the past. Check if today's date is on or after DateRangeEnd. 
       If Date >= DateRangeEnd Then 
        'See if the last due date before DateRangeEnd is valid. 
        TempDueDate = DateSerial(Year(DateRangeEnd), Month(DateRangeEnd), DayDue) 
        If TempDueDate <= DateRangeEnd Then 
         'Temp date is valid for end of date range. Check if valid for beginning. 
         If TempDueDate > DateRangeBegin Then 
          'Temp date is last valid due date. 
          GetNextDueDate = TempDueDate 
         Else 
          'There is no valid due date within the given date range. 
          GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
         End If 
        Else 
         'DayDue for the same month as DateRangeEnd is after DateRangeEnd. Check for the previous month. 
         TempDueDate = DateSerial(Year(DateRangeEnd), Month(DateRangeEnd) - 1, DayDue) 
         'Verify that temp date is after DateRangeBegin. 
         If TempDueDate > DateRangeBegin Then 
          'Temp date is last valid due date. 
          GetNextDueDate = TempDueDate 
         Else 
          'There is no valid due date within the given date range. 
          GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
         End If 
        End If 
       Else 
        'Today's date falls within the specified date range. Attempt to get valid due date after today. 
        If DayDue > Day(Date) Then 
         TempDueDate = DateSerial(Year(Date), Month(Date), DayDue) 
         'Check that TempDueDate is on or before DateRangeEnd. 
         If TempDueDate <= DateRangeEnd Then 
          GetNextDueDate = TempDueDate 
         Else 
          'DayDue for the current month is past DateRangeEnd. Determine if DayDue prior to DateRangeEnd is valid. 
          TempDueDate = DateSerial(Year(Date), Month(DateRangeEnd) - 1, DayDue) 
          If TempDueDate > DateRangeBegin Then 
           GetNextDueDate = TempDueDate 
          Else 
           'There is no valid due date within the given date range. 
           GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
          End If 
         End If 
        Else 
         'Today's date is on or past the DayDue for this month. Try for next month. 
         TempDueDate = DateSerial(Year(Date), Month(Date) + 1, DayDue) 
         'Check that TempDueDate is on or before DateRangeEnd. 
         If TempDueDate <= DateRangeEnd Then 
          GetNextDueDate = TempDueDate 
         Else 
          'DayDue for next month is past DateRangeEnd. Verify that due date for this month is after DateRangeBegin. 
          TempDueDate = DateSerial(Year(Date), Month(Date), DayDue) 
          If TempDueDate > DateRangeBegin Then 
           GetNextDueDate = TempDueDate 
          Else 
           'There is no valid due date within the given date range. 
           GetNextDueDate = "#ERROR_NO_VALID_DUE_DATE" 
          End If 
         End If 
        End If 
       End If 
     End Select 
    End If 

ExitGetNextDueDate: 
    Exit Function 
HandleErr_GetNextDueDate: 
    MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description,  vbCritical, "An Error Occured During GetNextDueDate Function" 
    Resume ExitGetNextDueDate 

End Function 

我希望這是對你有幫助。