Excel VBA比較兩個單元格的日期時出錯

Question

在我的工作表列B：C中允許日期。 我正在嘗試創建一個檢查，看看在C中輸入的日期是否比B更新，如果這么好，否則提醒用戶並清除內容。 我的代碼在application.intersect行中返回運行時錯誤91：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Dates As Range
    Set Dates = Range("C4:C12")

    If Target.Cells.Count > 1 Or IsEmpty(Target) Then
    Exit Sub
    End If
    If Not Application.Intersect(Dates, Range(Target.Address)).Value > ActiveCell.Offset(0, -1).Value Then
    GoTo DatesMissMatch
    Else
        Exit Sub
    End If

DatesMissMatch:
    Target.ClearContents
    ActiveCell.Value = "A2"
    MsgBox "Please re-check dates"
End Sub

Answer 1

我改變了你的方法，但這似乎有效。

我還注意到你正在向ActiveCell而不是Target編寫A2 。 您是否希望在輸入無效數據時更新C列中的單元格，或者您是否打算將其移動到哪個單元格中進行更改？

無論如何，這是我想出來的一種方式

Private Sub Worksheet_Change(ByVal Target As Range)

        If Target.Cells.Count > 1 Or IsEmpty(Target) Then
                Exit Sub
        End If

        If Target.Column = 3 Then 'Check to see if column C was modified
                If Target.Value < Target.Offset(0, -1).Value Then
                        Target.ClearContents
                        Target.Value = "A2"
                        MsgBox "Please re-check dates"
                End If
        End If

End Sub

如果你想堅持你目前正在做的方式，那么我認為你需要檢查交叉點是否為空，因為另一個答案結束。

Answer 2

您可以循環行並比較日期。

Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet

Dim lRow As Long
lRow = 4
Do While lRow <= ws.UsedRange.Rows.count
    If ws.Range("C" & lRow).Value > ws.Range("B" & lRow).Value then
         GoTo DatesMissMatch
    End if
lRow = lRow + 1
Loop

Answer 3

我相信你只需檢查相交而不是比較。

Sub Worksheet_Change(ByVal Target As Range)

    Dim Dates As Range
    Set Dates = Range("C4:C12")

    If Target.Cells.Count > 1 Or IsEmpty(Target) Then
    Exit Sub
    End If

    If Not Application.Intersect(Dates, Range(Target.Address)) Is Nothing Then
        If Target.Value < Target.Offset(0, -1).Value Then
            GoTo DatesMissMatch
        Else
            Exit Sub
        End If
    End If

DatesMissMatch:
    Target.ClearContents
    ActiveCell.Value = "A2"
    MsgBox "Please re-check dates"
End Sub