使用excel vba迭代开始date和结束date

我正在写一个Excel VBA代码，我想迭代开始结束date加2。

工作表1中的情景和假设如下所示

小区参考I1 = 2013年7月13日

从A1到C17的input表中，单元格值是带有列标题的

股票开始结束date
 dummy1      
 dummy2      
 dummy3      
 dummy4      
 dummy5      
 dummy6  

所需的代码逻辑

最初I1作为开始date，即第一行的13-Jul-18

在同一行，结束date应该加上+2，这将是15年7月15日

在下一行中， 开始date将是上一行的结束date（15-Jul-18），通过将+1将会是17-Jul-18

并在同一行中， 结束date将是相同的行开始date（18七月-18）将添加+2将18 – 7月18日

相同的逻辑stream向下一个出现的行，直到股票列是空的

如果该行起始端中的任何更改发生更改，则应该使用相同的上述逻辑从当前行到下一行开始更改

示例输出是

股票开始结束date
 dummy1 13-Jul-18 15-Jul-18
 dummy2 16-Jul-18 18-Jul-18
 dummy3 19-Jul-18 21-Jul-18
 dummy4 22-Jul-18 24-Jul-18
 dummy5 25-Jul-18 27-Jul-18
 dummy6 28-Jul-18 30-Jul-18

我已经写在下面的代码，需要你的帮助！

Sub zigZag() Dim wb As Workbook Dim ws As Worksheet Dim lastrow As Integer Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") ws.Activate currentValue = Range("I1").Value ws.Range("A2").Activate Do If ActiveCell.Value = "" Then Exit Do ActiveCell.Offset(0, 1) = currentValue ActiveCell.Offset(0, 2) = currentValue + 2 ActiveCell.Offset(1, 1) = ActiveCell.Offset(0, 2) + 1 ActiveCell.Offset(1, 2) = ActiveCell.Offset(1, 1) + 2 ActiveCell.Offset(2, 0).Activate Loop End Sub 

Answer 1

尝试这个

模块代码1'根据范围（“i1”）启动代码

 Sub zigZag() Dim wb As Workbook Dim ws As Worksheet Dim i As Long, r As Long Dim currentValue As Date Dim vDB As Variant, rngDB As Range Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") With ws currentValue = .Range("I1").Value r = .Range("a" & Rows.Count).End(xlUp).Row Set rngDB = .Range("b2", "c" & r) vDB = rngDB 'get Array from range(2 dimension) vDB(1, 1) = currentValue vDB(1, 2) = vDB(1, 1) + 2 For i = 2 To UBound(vDB, 1) vDB(i, 1) = vDB(i - 1, 1) + 3 vDB(i, 2) = vDB(i, 1) + 2 Next i End With rngDB = vDB End Sub 

'Module code 2 ~~>在表单事件代码中调用的代码

 Sub zigZagRng(rng As Range) Dim wb As Workbook Dim ws As Worksheet Dim i As Long, r As Long Dim vDB As Variant, rngDB As Range Dim currentValue As Date Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") With ws currentValue = rng.Value r = .Range("a" & Rows.Count).End(xlUp).Row Set rngDB = .Range(rng, "c" & r) vDB = rngDB 'get Array from range(2 dimension) vDB(1, 1) = currentValue vDB(1, 2) = vDB(1, 1) + 2 For i = 2 To UBound(vDB, 1) vDB(i, 1) = vDB(i - 1, 1) + 3 vDB(i, 2) = vDB(i, 1) + 2 Next i End With rngDB = vDB End Sub 

工作表事件代码

 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Row > 1 And Target.Column = 2 Then zigZagRng Target End If End Sub 

Answer 2

第一部分 ，下面的代码将首次运行，并根据单元格“I1”中的date修改所有date。

常规模块代码

 Option Explicit Sub zigZag() Dim wb As Workbook Dim ws As Worksheet Dim LastRow As Long, i As Long Dim CurrentStartDate As Date Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") With ws CurrentStartDate = .Range("I1").Value LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row in column "A" ' first row logic (with ref. of value in cell "I1") .Range("B2").Value = CurrentStartDate .Range("C2").Value = DateAdd("d", 2, CurrentStartDate) ' loop through the rest of the rows For i = 3 To LastRow .Range("B" & i).Value = DateAdd("d", 1, .Range("C" & i - 1).Value) ' current start equals previous end + 1 .Range("C" & i).Value = DateAdd("d", 2, .Range("B" & i).Value) ' current end equals current start + 2 Next i End With End Sub 

第二部分 ，你需要添加到你的Sheet1工作表模块， Worksheet_Change事件，所以每当有人改变列B的值（ start end ），那么该行和下面的所有date也将被修改。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, LastRow As Long ' if a 'start end' was modifed, in column "B" If Target.Column = 2 Then Application.EnableEvents = False LastRow = Cells(Rows.Count, "B").End(xlUp).Row Range("C" & Target.Row).Value = DateAdd("d", 2, Target.Value) ' add 2 days to current row end date For i = Target.Row + 1 To LastRow Range("B" & i).Value = DateAdd("d", 1, Range("C" & i - 1).Value) ' current start equals previous end + 1 Range("C" & i).Value = DateAdd("d", 2, Range("B" & i).Value) ' current end equals current start + 2 Next i End If Application.EnableEvents = True End Sub