Вставить строки на основе DateDiff

Question

У меня есть таблица, которую я использую для отслеживания моих классов. Мне нужно настроить его для экспорта в календарь. У меня есть все мои классы, перечисленные с датами начала и окончания. Я хочу иметь возможность вставлять строки ниже каждого перечисленного класса, используя разницу дат в виде числа строк, а затем копировать информацию в эти строки с соответствующими датами.

У меня есть следующий код, который вставляет строки, но затем дает мне ошибку «1004».

Public Sub Format() 
    Dim i As Long 
    Dim d As Long 

    LastRow = Worksheets("GCalExport").UsedRange.Rows.Count 

    For i = 2 To LastRow 
     d = DateDiff("d", Cells(i, "B"), Cells(i, "D")) 
     Cells(i, 1).Offset(1).Resize(d).EntireRow.Insert 
    Next i 
End Sub 

Answer 1

Вы получаете эту ошибку, потому что либо столбец B или столбец D (возможно, и оба) не содержат дату и DateDiff терпит неудачу.

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

Итак, вам нужно настроить свой код следующим образом:

Public Sub Format() 

Dim i As Long 
Dim d As Long 
Dim LastRow As Long 

With Worksheets("GCalExport") 
    LastRow = .UsedRange.Rows.Count 
    i = 2 

    While i <= LastRow 
     'Check if column B and column D actually contain a date 
     If IsDate(.Cells(i, "B")) And IsDate(.Cells(i, "D")) Then 
      d = DateDiff("d", .Cells(i, "B"), .Cells(i, "D")) 
      .Cells(i, 1).Offset(1).Resize(d).EntireRow.Insert 
      'Since you inserted d rows the next row to check is 
      ' row i + d 
      i = i + d 
      ' furthermore the last row just got increased by 
      ' d as well 
      LastRow = LastRow + d 
      'Move to the next row for processing 
      i = i + 1 
     Else 
      'If column B and/or D do not contain a valid date then 
      ' ignore that row and go to the next row. 
      i = i + 1 
     End If 
    Wend 
End With 

End Sub 

Примечание замечания для получения дополнительной информации.