Excel VBA - 周结束日期

Question

B 列是我的数据 - 如果 B 列中有日期值，请在 C 列中返回周结束日期。需要 VBA 代码来完成此操作

Column B      Column C

11/9/2016     11/11/2016
11/8/2016     11/11/2016
4/4/2017      4/7/2017
(blank)       (blank)
3/28/2017     3/31/2017

下面是我能得到的所有，但它没有任何好处。

Dim FirstDayInWeek, LastDayInWeek  As Variant
Dim dtmDate As Date
dtmDate = Range("B2:B")
LastDayInWeek = dtmDate - Weekday(dtmDate, vbUseSystem) + 7
MsgBox LastDayInWeek

Answer 1

我回复了您关于如何从给定日期找到一周开始日期的评论？ ，但这里是一个答案：

Function ReturnDate(DateRange As Date, Optional DayInWeek = 1) As Date
    ReturnDate = DateRange - Weekday(DateRange, vbUseSystem) + DayInWeek
End Function

=ReturnDate(A1)给出星期一
=ReturnDate(A1,2)给出星期二
.
=ReturnDate(A1,5)给出 Friday < --- 这是你想要的。
=ReturnDate(A1,7)给出星期日。

空白单元格将给出01/01/1900 ，但您可以为此添加检查或将单元格格式化为不显示 0。

Answer 2

也许你可以采用下面的方法

Sub ReturnWeekEndDate()
    Dim InpRng As Range
    Dim i As Long

    Set InpRng = ActiveSheet.Range("A2:B5")

    For i = 1 To InpRng.Rows.Count
        If IsDate(InpRng.Cells(i, 1).Value) And IsDate(InpRng.Cells(i, 2).Value) Then
            InpRng.Cells(i, 1).Offset(0, 2) = InpRng.Cells(i, 1).Value - Weekday(InpRng.Cells(i, 1).Value, vbUseSystem) + 7
        End If
    Next i
End Sub

Answer 3

试试这个：

Sub INeedADate()
    Dim i As Long, N As Long, r As Range, Bigr As Range

    N = Cells(Rows.Count, "B").End(xlUp).Row

    For i = 1 To N
        Set r = Cells(i, "B")
        If IsDate(r.Value) Then
            addy = r.Address
            r.Offset(0, 1).Value = Evaluate(addy & "-WEEKDAY(" & addy & ",3)+IF(WEEKDAY(" & addy & ",3)>4,11,4)")
        End If
    Next i
End Sub

这类似于使用工作表公式：

=B1-WEEKDAY(B1,3)+IF(WEEKDAY(B1,3)>4,11,4)

Answer 4

或者试试这个...

Sub GetFridayDate()
Dim LastDayInWeek   As Date
Dim Rng As Range, Cell As Range
Dim lr As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range("B2:B" & lr)
For Each Cell In Rng
    If IsDate(Cell.Value) Then
        LastDayInWeek = Cell + 8 - Weekday(Cell, vbFriday)
        Cell.Offset(0, 1) = LastDayInWeek
    End If
Next Cell
End Sub

Answer 5

你说这将是一个过程的一部分......所以，只要像我展示的那样调用这个函数，你就是金子！ 繁荣！

Sub FindEndOfWeek_Test()
Call FindEndOfWeek(ActiveSheet, 1, 2, 6, 1)
End Sub

Function FindEndOfWeek(Sht As Worksheet, KnownDate_Column As Integer, _
                       EndOfWeek_Column, EndOfWeek As Integer, _
                       StartingRow As Long)
' This function takes in a spreadsheet, and and determines the date at the end
'   of the week, based on known parameters being passed into the function.
'

Dim a As Long
Dim LastRow As Long
Dim EvalDate As Date
Dim NewDate As Date

' Determine the last row of the column you are working with
LastRow = Sht.Cells(Sht.Rows.Count, KnownDate_Column).End(xlUp).Row

' Loop through your entire spreadsheet to determine the end of the week for all rows
For a = StartingRow To LastRow
    If IsDate(Sht.Cells(a, KnownDate_Column).Value) = True Then
        NewDate = Sht.Cells(a, KnownDate_Column).Value
        EvalDay = Weekday(NewDate)
        ' Determine the known date day of the week, and add accordingly.
        If EvalDay < EndOfWeek Then
            Sht.Cells(a, EndOfWeek_Column).Value = NewDate + (EndOfWeek - EvalDay)
        ElseIf EvalDay > EndOfWeek Then
            Sht.Cells(a, EndOfWeek_Column).Value = NewDate + (7 - EvalDay + EndOfWeek)
        Else
            Sht.Cells(a, EndOfWeek_Column).Value = NewDate
        End If
    End If
Next a

End Function

Answer 6

我认为不需要 vba，您使用以下公式：

=IF(B2<>"",B2+(7-WEEKDAY(B2,16)),"")

Answer 7

如果您真的需要 VBA 代码来解决这个问题，我就是这样做的，您可以将 excel 公式转换为单行解决方案，如下所示：

WeekendingDate = Date + 7 - WorksheetFunction.Weekday(Date + 7 - 6)