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が失敗したため、このエラーを取得しています。

これは、2行を挿入して次の行に移動すると発生します。もちろん、新しく挿入された行は空で、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 

詳細についてはコメントを注意してください。