Excel VBA Macro для управления строками на основе критериев

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 

Что я хочу Macro сделать это, Проверьте, если разница «Дата начала» и «Дата окончания» больше 2. Если разница между ними равна 1 или 0, она переходит к следующей строке данных для проверки. Однако, если его больше 0 или 1, он добавляет еще одну строку под эту конкретную строку. Затем он копирует аналогичный контент, но затем меняет дату.

Например,

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

После Macro, это добавляет под исходной строке.

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 

Если данные выборки точно представлены фактические данные, то выше, должны быстро расширить свои диапазоны дат для одного разделения дня для каждой строки.