如果周六或周日落在星期一或星期日

Question

请移动下一个日期，如果星期六或星期日落入使用VBA宏，请一直添加到星期一。我宁愿不使用公式。下面的代码使日期在本周的任何时候都增加。非常感谢您的帮助，真的很感激。请让我知道，如果问题不明确，我会尝试重新制定。再次感谢。

Private Sub Worksheet_Change(ByVal target As Range) 
    Dim d1 As Date, d2 As Date, d3 As Date 

    d1 = DateAdd("w", 1, Date) 
    d2 = DateAdd("w", 7, Date) 
    d3 = DateAdd("w", 3, Date) 

    If Not Intersect(target, Range("H3:H150")) Is Nothing Then 
     If target.Value = 7 Then 
      target.Offset(0, 1).Value = d2 
     ElseIf target.Value = 3 Then 
      target.Offset(0, 1).Value = d3 
     ElseIf target.Value = 1 Then 
      target.Offset(0, 1).Value = d1 
     Else 
     End If 
    End If 
End Sub 

Answer 1

一般来说，检查周六或周日的函数叫做Weekday。 0是星期日，6是星期六。您可以在VBE与内置的统计员使用它，以确保一切正常：

Option Explicit 

Public Sub TestMe() 

    Debug.Print Weekday(Now) = vbMonday 
    Debug.Print Weekday(Now) = vbTuesday 

End Sub 

一周的第一天是在Weekday()功能的可选参数，默认设置为vbSunday：

---

不过，我敢肯定的是，NetworkDays() formula会做非常好。

它的构想是忽略周六和周日。 这里是一个小例子：

Option Explicit 

Public Sub PrintNetworkDays() 

    Dim dtStartDate  As Date 
    Dim dtEndDate  As Date 
    Dim rngHolidays  As Range 

    dtStartDate = DateSerial(2017, 7, 1) 
    dtEndDate = DateSerial(2017, 8, 1) 

    Set rngHolidays = ActiveSheet.Range("A:A") 

    rngHolidays(1, 1) = DateSerial(2017, 7, 5) 
    rngHolidays(2, 1) = DateSerial(2017, 7, 6) 
    rngHolidays(3, 1) = DateSerial(2017, 7, 7) 
    rngHolidays(4, 1) = DateSerial(2017, 7, 8) 
    rngHolidays(5, 1) = DateSerial(2017, 7, 9) 

    Debug.Print WorksheetFunction.NetworkDays(dtStartDate, dtEndDate, rngHolidays) 

End Sub 

Answer 2

像这样的东西可以帮助

Function NextMonday(dtDate As Date, lngDaysToAdd As Long) 

Dim intDaysOffset As Integer 

NextMonday = DateAdd("d", lngDaysToAdd, dtDate) 

intDaysOffset = (7 - Weekday(NextMonday, vbMonday)) + 1 

NextMonday = DateAdd("d", intDaysOffset, NextMonday) 

End Function