Question

我尝试过搜索和谷歌搜索解决方案，但无济于事。如果我有错过的解决方案，我现在道歉。

（我的Excel数据库） - 运行宏

之前

Start Date  Start Time  Number  Finish Date Finish Time
14-Jul-15   22:00   1   16-Jul-15   06:00
15-Jul-15   22:00   1   17-Jul-15   06:00
15-Jul-15   22:00   1   16-Jul-15   06:00

（我的Excel数据库） - 运行宏

后

Start Date  Start Time  Number  Finish Date Finish Time
14-Jul-15   22:00   1   16-Jul-15   06:00
14-Jul-15   22:00   1   15-Jul-15   06:00
15-Jul-15   22:00   1   16-Jul-15   06:00
15-Jul-15   22:00   1   17-Jul-15   06:00
15-Jul-15   22:00   1   16-Jul-15   06:00
16-Jul-15   22:00   1   17-Jul-15   06:00
15-Jul-15   22:00   1   16-Jul-15   06:00

我希望宏做的是，检查“开始日期”和“完成日期”之间的差异是否大于2。如果两者之间的差异为1或0，则它将移至下一行数据以进行检查。但是，如果它大于0或1，则在该特定行下添加另一行。然后它复制相似的内容，然后修改日期。

例如，

14-Jul-15   22:00   1   16-Jul-15   06:00

宏之后，它会在原始行下添加。

14-Jul-15   22:00   1   15-Jul-15   06:00
15-Jul-15   22:00   1   16-Jul-15   06:00

对不起，如果我的问题不清楚，请帮我创建这个宏。

Answer 1

在循环中插入行时，始终从底部开始处理，否则您可能会在插入新行时丢失步骤序列。通过向上步进，新插入的行假设行号已经超出了循环的范围。

Sub StackOverflow()
    Dim rw As Long, i As Long
    With ActiveSheet
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            If (CDate(.Cells(rw, 4).Value2) - CDate(.Cells(rw, 1).Value2)) > 1 Then
                For i = 1 To (CDate(.Cells(rw, 4).Value2) - CDate(.Cells(rw, 1).Value2))
                    With .Cells(rw, 1).Resize(1, 5)
                        .Copy
                        .Insert Shift:=xlDown   ', copyorigin:=.Cells
                    End With
                    .Cells(rw + 1, 4) = .Cells(rw + 1, 4).Value2 - (i - 1)
                    .Cells(rw + 1, 1) = .Cells(rw + 1, 4).Value2 - 1
                Next i
            End If
        Next rw
    End With
    Application.CutCopyMode = False
End Sub

如果您的样本数据准确地表示了实际数据，那么上述内容应该会快速将您的日期范围扩展到每行的一天分隔。

Excel VBA宏根据条件操作行

1 个答案: