如果星期六或星期日下降，请将下一个Dateadd移至星期一

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