Ошибка времени выполнения 13 - Несоответствие по дате

Question

avid reader, первый раз здесь. У меня есть макрос, который я получил из Интернета по большей части, а затем внес некоторые коррективы. Цель состоит в том, чтобы окрасить кодовые ячейки, прошедшие определенную продолжительность. Раньше он работал нормально, но теперь я получаю сообщение об ошибке «Тип несоответствия». Строка, которая гласит: «Здесь ошибка», я получаю несоответствие. Я озадачен тем, что раньше он работал нормально. Я не опытный программист каким-либо образом, но я просто пытаюсь устранить проблемы. Я просмотрел всю сеть и не могу найти конкретного ответа на мой вопрос.

Кроме того, если кто-либо из вас желает, я был бы признателен за ваш совет о том, как сделать этот код ТОЛЬКО при запуске книги и НЕ периодически, поскольку он настроен для этого сейчас. Этот код не размещен на листе, но в модуле. Я упоминаю об этом, потому что я не уверен, сколько практической разницы он может оказать любую помощь, спасибо!

Public TimeToRun As Date 

Sub Auto_Open() 
Call ScheduleCompareTime 
    End Sub 

Sub ScheduleCompareTime() 
TimeToRun = Now + TimeValue("00:00:10") 
Application.OnTime TimeToRun, "CompareTimeStamp" 
    End Sub 

Sub CompareTimeStamp() 
Dim rgTimeStamp As Range 
Dim rdTimeStamp As Range 
Dim i As Long 
Dim j As Long 
Dim MyNow As Date 
Dim TimeStamp As Date, TimeStampp As Date 

Set rgTimeStamp = Range("c1:c500") 
Set rdTimeStamp = Range("H1:h500") 

For i = 1 To rgTimeStamp.Rows.Count 

    If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell 

     MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly 
     TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!! 
     If TimeStamp < MyNow Then 'if it's old at all 
      rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red 
     End If 
    End If 

    Next 

For j = 1 To rdTimeStamp.Rows.Count 

    If Not rdTimeStamp.Cells(j, 1) < 1 Then 

     MyNow = CDate(Now - TimeSerial(0, 0, 0)) 
     TimeStampp = CDate(rdTimeStamp.Cells(j, 1)) 
     If TimeStampp < MyNow Then 
      rdTimeStamp.Cells(j, 1).Interior.ColorIndex = 3 
     End If 


    End If 'closes If Not 
Next 
Call ScheduleCompareTime 'begins the scheduler again 
End Sub 

Sub auto_close() 'turn the scheduler off so you can close workbook 
Application.OnTime TimeToRun, "CompareTimeStamp", , False 
End Sub 

Answer 1

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

'.... beginning of your code 

If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell 

    MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly 

    If IsDate(rgTimeStamp.Cells(i, 1)) = False Then 
     MsgBox "Invalid date found in cell " & rgTimeStamp.Cells(i, 1).Address(False, False) 
     Exit Sub 
    End If 

    TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!! 
    If TimeStamp < MyNow Then 'if it's old at all 
     rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red 
    End If 
End If 


'... rest of your code 

Если вы хотите только код для запуска при запуске затем изменить Sub Auto_Open к этому:

Sub Auto_Open() 
Call CompareTimeStamp 
End Sub