Question

我正在写一个excel VBA代码，我希望迭代开始结束和结束日期加上+2。

sheet1中的场景和假设如下所示

细胞参考 I1 = 2018年7月13日

输入表从A1到C17，单元格值带有列标题

stocks  start end   end date
dummy1      
dummy2      
dummy3      
dummy4      
dummy5      
dummy6

需要的代码逻辑

最初 I1 作为第一行的开始日期i，e 13-Jul-18

在同一行中，结束日期应添加+2，即 15-Jul-18

在下一行中，开始日期将是上一行结束日期（15-Jul-18），方法是添加 +1 将于18-Jul-18

在同一行中，结束日期将是开始日期（16-Jul-18）的<+>增加+2 18-Jul-18

相同的逻辑流向下一个出现的行，直到库存列为空

如果该行开头的任何更改发生变化，则更改应从当前行开始，然后使用相同的逻辑进行下一行

输出示例

stocks  start end   end 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

第一部分，下面的代码将首次运行，并根据单元格中的日期修改所有日期＆＃34; I1＆＃34;。

常规模块代码

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列中的值时（{{1} }），那么该行及以下的所有日期也将被修改。

start end

Answer 2

试试这个

模块代码1＆＃39;根据范围启动代码（＆＃34; i1＆＃34;）

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

＆＃39;模块代码2 ~~＆gt;要在工作表事件代码中调用的代码

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

使用excel vba迭代开始日期和结束日期

2 个答案: