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

我回复了你对how to find the start date of week from a given date?的评论，但这里是答案：

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)给出星期五＆lt; ---这就是你要追求的人 =ReturnDate(A1,7)给了星期天。

空格单元格会显示01/01/1900，但您可以为此添加格式或格式化单元格不显示0。

Answer 2

Perhapse你可以采取类似下面的方法

<script>

<b:if cond='data:blog.searchLabel'>

var URLArray = <b:eval expr='data:posts map (post =&gt; post.url)'/>;
var TitleArray = <b:eval expr='data:posts map (post =&gt; post.title)'/>;  
var cURL = "<data:post.url/>";
var gTitle = "<data:post.title>";

//<![CDATA[

function IndexFinder(element,index) {
   return element == cURL
}
function IndexFinderT(element,index){
   return element == gTitle;
}
var sU = URLArray.findIndex(IndexFinder);
var sT = TitleArray.findIndex(IndexFinderT);

function prevURL(){
    var prevU=URLArray[sU-1];
return prevU;
}
function prevTitle(){
    var prevT=TitleArray[sT-1];
return prevT;
}
function nextURL(){
    var nextU=URLArray[sU+1];
return nextU;
}
function nextTitle(){
    var nextT=TitleArray[sT+1];
return nextT;
}

//]]>

</b:if>

</script>

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

你说过这将是一个过程的一部分...所以，只要按照我所展示的那样调用这个功能，你就是金色的！ BOOM！

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)

Excel VBA - 周结束日期

7 个答案: