Question

狂热的读者，第一次在这里发布海报。我有一个宏，我从互联网上获得了大部分，然后做了一些调整。它的目的是为已经过一定持续时间的单元格着色。它之前的工作正常，但现在我因为＃34; Type Mismatch＆＃34;而收到错误。读取的行＆＃34;这是错误的位置＆＃34;是我得到不匹配的地方。我很困惑，因为它之前的工作正常。无论如何我不是一个经验丰富的程序员，但我只是试图解决问题。我遍布网络，无法找到我问题的具体答案。

此外，如果您有任何人愿意，我将非常感谢您就如何使该代码仅在工作簿启动时运行而不是定期运行，因为它现在已经设置好了。此代码未放入一个工作表，但在一个Module.I提到这个，因为我不确定它可以提供多少实际的差异，谢谢，谢谢！

 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

运行时错误13 - 日期不匹配

1 个答案: