Excel vba - 禁用多个单元格中的粘贴

我正在编写代码，将一列中输入的日期与另一列中的日期进行比较 . 如果条目违反数据验证规则，则会显示错误消息 .

此外，我已禁用剪切粘贴操作和ctl d .

Data Validation rules:

• 输入01/01/1900至12/31/9999之间的有效日期

• 列AP中的日期值应大于列AO .

但是，当用户复制单元格时，选择目标列中的多个单元格并粘贴，则数据验证根本不会触发 . 以下是截图：

下面的代码处理单个单元格操作，例如复制单元格并粘贴到另一个单元格中，但是当用户选择多个单元格并粘贴时无法处理 .

请帮我理解我的代码有什么问题 . 谢谢！

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrorHandler

    Dim lstrow As Long
    lstrow = Range("A" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub
    If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
        Application.EnableEvents = False
        Target.Value = ""
        MsgBox ("The date you have entered is either not in correct format OR less than date in column AO")
    Else: Target.NumberFormat = "dd-mmm-yyyy"
    End If
ErrorExit:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Debug.Print Err.Number & vbNewLine & Err.Description
    Resume ErrorExit

End Sub

我尝试了下面的代码，但它没有用 .

if Target.cells.count > 1 then
msgbox("Select a single cell to paste")
ActiveCell.Select
end if

“================================================= =======================

我遇到了另一个问题 . 现在，我想在worksheet_change事件下的同一工作表中再评估一列 . 但是，只对一列的代码进行评估，而不是另一列 .

请指教 .

Here is my updated code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Added to define the last row by locating the text string (blank)
    On Error GoTo ErrorHandler

    Dim lstrow As Long
    'ActiveRow = ActiveCell.Row
    lstrow = Range("A" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("AP5:AP" & lstrow)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "Select only single cell to paste"
        ActiveCell.Select
        Application.CutCopyMode = False
        Application.EnableEvents = True
        Exit Sub
    End If
    If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
        Application.EnableEvents = False
        Target.Value = ""
        MsgBox ("The date you have entered is either not in correct format OR less than Column AO")
    Else: Target.NumberFormat = "dd-mmm-yyyy"
    Application.EnableEvents = True
    Exit Sub
    End If
'----------------------------------------------------------------------------------
    If Intersect(Target, Range("AL5:AL" & lstrow)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "Select only single cell to paste"
        ActiveCell.Select
        Application.CutCopyMode = False
        Application.EnableEvents = True
        Exit Sub
    End If
    If Target.Value <> "" And Target.Value <= Range("AK" & Target.Row) Then
        Application.EnableEvents = False
        Target.Value = ""
        MsgBox ("The value you entered is less than the value in column AK")
    Else: Target.NumberFormat = "0.00"
    Application.EnableEvents = True
    Exit Sub
    End If
'----------------------------------------------------------------------------------
ErrorExit:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Debug.Print Err.Number & vbNewLine & Err.Description
    Resume ErrorExit

End Sub

我们可以在同一个worksheet_change事件中评估两个不同的范围吗？

screenshot of the worksheet after the code is run: