Question

我坚持使用其中一个VBA代码。我的要求是当用户选择＆＃34; Resigned＆＃34;在提供数据验证的K行中，他应该收到弹出消息＆＃34;请在L2和＃34;列上以DD-MM-YYYY格式提供用户的上次工作日期。这里只是一个例子。

但是，当我点击删除键时，选择范围K2：K18收到消息＆＃34;运行时错误13，键入不匹配＆＃34;

请帮助解决此问题：（

以下是我的代码。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
If Target.Value <> "Resigned" Then Exit Sub
MsgBox "Please provide the user's Last Working Date in DD-MM-YYYY format on " & Target.Offset(0, 1).Address

End Sub

Answer 1

您需要检查If Target.Cells.Count <> 1并妥善处理。

在您的情况下，您导致_Change事件将Target参数作为数组Range("K2:K18")，因此类型不匹配错误。

这是一个简单的案例，如果Target超过1个单元格区域，则只会中止该过程：

Private Sub Worksheet_Change(ByVal Target As Range)
    'Conditions which cause the event to terminate early, avoid errors
    If Target.Cells.Count <> 1 Then Exit Sub
    If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub

    If Target.Value = "Resigned" Then 
        MsgBox "Please provide the user's Last Working Date in DD-MM-YYYY format on " & Target.Offset(0, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
        Application.GoTo Target.Offset(0,1)
    End If
End Sub

或者，要处理多个单元格范围，您可以执行以下操作：

Private Sub Worksheet_Change(ByVal Target As Range)
    'Conditions which cause the event to terminate early, avoid errors
    Dim rng As Range, cl As Range, msg as String
    Set rng = Intersect(Target, Range("K:K"))
    If rng Is Nothing Then Exit Sub

    For Each cl in rng
        If cl.Value = "Resigned" Then 
            msg = msg & vbCRLF & cl.Offset(0,1).Address(False,False)
        End If
    Next
    If msg <> vbNullString Then
        MsgBox "Please provide the user's Last Working Date in DD-MM-YYYY format on " & vbCrlf & msg
    End If
End Sub

当我删除一系列单元格（K2：K18）获取调试消息时

1 个答案: