Сделать excel vba вставить произвольное количество строк данных между строками на основе пользовательских критериев

Question

Я не уверен, как объяснить этот вопрос, но я постараюсь изо всех сил объяснить логику того, что мне нужно сделать. Надеюсь, любой из блестящих парней на этом сайте мог бы вникать в некоторые идеи :)

У меня есть журнал данных, содержащий информацию о разных проектах. Каждая строка содержит информацию о проекте, таком как название проекта, дата создания проекта, дата завершения проекта, расчетная дата завершения проекта и отметка времени, когда была добавлена ​​/ обновлена ​​сметная оценка. Если проект имеет обновленную расчетную дату завершения проекта, это обновление записывается в новую строку. Вот как должны выглядеть данные в Excel.

мне нужно преуспеть, чтобы проверить, если какой-либо день проходит без каких-либо изменений в предполагаемой даты завершения (т.е. проект остается на трассе), то первенствовать создает строки до тех пор, пока не достигнет дня, содержащего обновление. На следующем рисунке показано, как мне нужно Excel, чтобы добавить пользовательские строки на основе начальных строк выше.

Пожалуйста, дайте мне помочь с любыми идеями .. рекомендуется VBA.

Answer 1

Я считаю, что это должно выполнить свои цели:

Sub FillCompletionDays() 

Dim LLoop As Long 
Dim LLRow As Long 
Dim DateEnd As Date 
Dim DateNext As Date 
Dim DateNow As Date 

LLoop = Range("A:A").Find(what:="Project name").Row + 1 
LLRow = Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row 

If LLRow <= LLoop Then Exit Sub 

Do 
    'Only proceed if there is a valid date in column E 
    If Range("E" & LLoop).Value2 <> vbNullString Then 
     DateNow = Range("E" & LLoop).Value2 
     DateEnd = Range("C" & LLoop).Value2 
     'Check if another date is needed 
     If DateEnd > DateNow Then 
      'Check if next row is this project 
      If Range("A" & LLoop + 1).Value2 = Range("A" & LLoop).Value2 Then 
       'Check if a new date is needed 
       DateNext = DateSerial(Year(Range("E" & LLoop + 1).Value2), Month(Range("E" & LLoop + 1).Value2), _ 
       Day(Range("E" & LLoop + 1).Value2)) 
       If DateNext <> DateNow + 1 Then 
        'Insert a row 
        Rows(LLoop + 1).Insert shift:=xlShiftDown 
        Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2 
        Range("E" & LLoop + 1).Value2 = DateNow + 1 
        Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd" 
        LLRow = LLRow + 1 
       End If 

      Else 
       'Next row is another project; insert a row for this one 
       Rows(LLoop + 1).Insert shift:=xlShiftDown 
       Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2 
       Range("E" & LLoop + 1).Value2 = DateNow + 1 
       Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd" 
       LLRow = LLRow + 1 
      End If 
     End If 
    End If 
    LLoop = LLoop + 1 
Loop Until LLoop > LLRow 

End Sub 

Answer 2

Вот ответ на мой вопрос после редактирования @Nick Peranzi ответа, чтобы соответствовать моему запросу я не знаю, как помечать/упоминать его, но это его ссылка пользователя https://stackoverflow.com/users/5472502/nick-peranzi

Sub FillCompletionDays() 

Dim LLoop As Long 
Dim LLRow As Long 
Dim DateEnd As Date 
Dim DateNext As Date 
Dim DateNow As Date 

LLoop = Range("A:A").Find(what:="Project name").Row + 1 
LLRow = Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row 

If LLRow <= LLoop Then Exit Sub 

Do 
'Only proceed if there is a valid date in column E 
If Range("E" & LLoop).Value2 <> vbNullString Then 
    DateNow = DateSerial(Year(Range("E" & LLoop).Value2), Month(Range("E" & LLoop).Value2), _ 
      Day(Range("E" & LLoop).Value2)) 
    DateEnd = DateSerial(Year(Range("D" & LLoop).Value2), Month(Range("D" & LLoop).Value2), _ 
      Day(Range("D" & LLoop).Value2)) 
    'Check if another date is needed 
    If DateEnd > DateNow Then 
     'Check if next row is this project 
     If Range("A" & LLoop + 1).Value2 = Range("A" & LLoop).Value2 Then 
      'Check if a new date is needed 
      DateNext = DateSerial(Year(Range("E" & LLoop + 1).Value2), Month(Range("E" & LLoop + 1).Value2), _ 
      Day(Range("E" & LLoop + 1).Value2)) 
      If DateNext = DateNow Then 
      Else 
      If DateNext <> DateNow + 1 Then 
       'Insert a row 
       Rows(LLoop + 1).Insert shift:=xlShiftDown 
       Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2 
       Range("E" & LLoop + 1).Value2 = DateNow + 1 
       Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd" 
       LLRow = LLRow + 1 
      End If 
      End If 

     Else 
      'Next row is another project; insert a row for this one 
      Rows(LLoop + 1).Insert shift:=xlShiftDown 
      Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2 
      Range("E" & LLoop + 1).Value2 = DateNow + 1 
      Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd" 
      LLRow = LLRow + 1 
     End If 
    End If 
End If 
LLoop = LLoop + 1 
Loop Until LLoop > LLRow 


End Sub