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)