Получение Excel для вставки новой строки для отсутствующих дат для нескольких столбцов

Question

Итак, у меня есть книга с 18 столбцами дат с точками данных и примерно 3 тыс. Строк. Я пытаюсь убедиться, что все строки имеют одинаковые даты. Если дата отсутствует, я хочу добавить новую строку с отсутствующей датой и # N/A рядом с ней. Некоторые столбцы пропустили несколько дней по сравнению с предыдущими столбцами.

Я искал, и я думаю, что нашел макрос, который может работать, но я не очень хорошо разбираюсь в VBA, поэтому я не уверен, как настроить его, чтобы он работал для нескольких столбцов:

Sub insertMissingDate() 
    Dim wks As Worksheet 
    Set wks = Worksheets("Sheet1") 

    Dim lastRow As Long 
    lastRow = wks.Range("C2").End(xlDown).Row 

    'Work bottom up since we are inserting new rows 
    For i = lastRow To 3 Step -1 
     curcell = wks.Cells(i, 3).Value 
     prevcell = wks.Cells(i - 1, 3).Value 

     'Using a loop here allows us to bridge a gap of multiple missing dates 
     Do Until curcell - 1 = prevcell Or curcell = prevcell 
      'Insert new row 
      wks.Rows(i).Insert xlShiftDown 

      'Insert missing date into new row 
      curcell = wks.Cells(i + 1, 3) - 1 
      wks.Cells(i, 3).Value = curcell 
     Loop 
    Next i 
End Sub 

EDIT: Я приложил изображения, чтобы сделать его проще!

Это показывает проблему, где даты рассогласованы

Это показывает фиксированную строку - с клетками, смещенная вниз

В идеале, я хотел бы быть чтобы найти способ найти все отсутствующие даты и вставить строку, подобную этой, без необходимости делать это вручную.

Answer 1

Как об этом:

Option Explicit 

Sub insertMissingDate() 
    Const FIRST_ROW  As Integer = 2 

    Const COMPARE_COL As Integer = 3 
    Const COL1   As String = "C" 
    Const COL2   As String = "D" 

    Dim wks    As Worksheet 
    Dim strRange  As String 
    Dim lastRow   As Long 
    Dim i    As Long 

    Dim curCell   As Date 
    Dim prevCell  As Date 

    Set wks = Worksheets("Sheet1") 


    lastRow = wks.Range(COL1 & FIRST_ROW).End(xlDown).Row 

    'Work bottom up since we are inserting new rows 
    For i = FIRST_ROW To lastRow 

     curCell = wks.Cells(i, COMPARE_COL).Value 
     prevCell = wks.Cells(i, COMPARE_COL - 2).Value 

     If curCell <> prevCell Then 
      strRange = COL1 & i & ":" & COL2 & i 
      Range(strRange).Insert Shift:=xlDown 

      wks.Cells(i, COMPARE_COL).Value = prevCell 
      wks.Cells(i, COMPARE_COL + 1).Value = "#N/A" 
     End If 
    Next i 

    Set wks = Nothing 
End Sub