Question

在工作表INPUT中，输入星期计划的数据行。每天可以有多行。 A列包含计划原始周的日期。当在INPUT表中设置完整的计划（比如15行乘10列数据）时，可以运行一个宏，将计划复制到OUTPUT表并创建一整年。因此，我编写VBA代码来复制数据块并将其粘贴到前一周，并将日期更新为7天。

我在使用DateAdd功能时遇到了困难。

有谁知道一个好的解决方案？

Dim i As Integer
Dim rowCount As Long
Dim columnCount As Long

Sheets("OUTPUT").Select
Sheets("OUTPUT").Cells.Clear
Sheets("INPUT").Select
rowCount = Sheets("INPUT").Range("A6", Sheets("INPUT").Range("A6").End(xlDown)).Rows.Count - 1
columnCount = Sheets("INPUT").Range("A5", Sheets("INPUT").Range("A5").End(xlToRight)).Columns.Count - 1
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("OUTPUT").Select
Range("A1").Select
ActiveSheet.Paste

For i = 1 To 51

    Range("A" & Rows.Count).End(xlUp).Select
    Range(Selection, Selection.Offset(-rowCount, columnCount)).Copy
    Range("A" & Rows.Count).End(xlUp).Select
    ActiveCell.Offset(1, 0).PasteSpecial
    Range("A" & Rows.Count).End(xlUp).Select
    Range(Selection, Selection.Offset(-rowCount, 0)).Value = DateAdd("d", 7, Range(Selection, Selection.Offset(-rowCount, 0)).Value)

接下来我

Answer 1

Variable= DateAdd("d", 7, Variable)

Answer 2

我不完全确定你使用columnCount做了什么，所以这可能需要修改，但我认为这样的事情应该让你开始

Dim dateVals
Dim destRange as Range
Dim cl as Range
For i = 1 To 51
    ' initial data
    ' this gets a range from the last cell in column A, offset by the rowCount variable, and resized based on row/col counters
    Set rng = Range("A" & Rows.Count).End(xlUp).Offset(-rowCount).Resize(rowCount,colu‌mnCount)
    ' similar size range beginning in row after 'rng'
    Set destRange = rng.Offset(rng.Rows.Count)

    ' Instead of copying the cells/paste special, just transfer the values directly
    ' Range(rng, rng.Offset(-rowCount, columnCount)).Copy
    destRange.Value = rng.Value

    ' Add 7 days to each cell value
    ' I assume you only have date values in column 1
    For Each cl in destRange.Columns(1).Cells
        cl.Value = DateAdd("d", 7, CDate(cl.Value))
    Next

Next i

在VBA的一系列日期中添加一周

2 个答案: