Question

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

另外，我已禁用剪切粘贴操作和ctl + d。

数据验证规则：

输入有效日期01/01/1900至12/31/9999
列AP中的日期值应大于列AO。

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

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

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

这是我的代码：

    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事件下的同一工作表中再评估一列。但是，只有一列的代码正在评估，而不是另一列。

请告知。

以下是我更新的代码：

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事件中评估两个不同的范围吗？

代码运行后

工作表的屏幕截图：

Answer 1

行后

If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub

尝试插入此附加检查：

  If Target.Cells.Count > 1 Then
    Application.EnableEvents = False
    Application.Undo
    msgBox "entering many cells simultaneously in column AP is not allowed"
    Application.EnableEvents = True
    Exit Sub
  End If

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

1 个答案: