Satırları DateDiff'e göre ekle

Question

Sınıflarımı izlemek için kullandığım bir elektronik tablom var. Bir takvime ihracat için ayarlamam gerekiyor. Tüm sınıflarım başlangıç ​​ve bitiş tarihleriyle listeleniyorum. Listelenen her bir sınıfın altına, tarih farkını satır sayısı olarak kullanarak ve sonra ilgili tarihlerle bu satırlara kopyalayabilmek istiyorum.

Satırları ekleyen, ancak bana '1004' hatası veren aşağıdaki kodu kullanıyorum. B sütunu veya sütun D (muhtemelen her ikisi) ya bir tarih içermiyor ve DateDiff arızalandığı için

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

Bu hatayı alıyorsanız.

Bu, birkaç satır eklediğinizde ve bir sonraki satıra geçtiğinizde olur. Tabii ki, yeni eklenen satır boştur ve sütun B'de veya sütun D'de bir tarih içermez (ve yukarıdaki hata oluşur).

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 

Not yorumlarınızı fazla bilgi için:

Yani, aşağıdaki gibi kodunuzu ayarlamanız gerekir.