Question

以下代码旨在仅允许在单元格范围内输入1,2或3。如果输入其他内容，则会弹出一条错误消息并撤消该条目。除非用户填写他们的回复，否则代码将完美运行。此时，出现“运行时错误'13'”。我希望用户能够填写他们的条目，有没有办法解决这个错误？

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
    Application.Calculation = xlManual

    If Not Intersect(Target, [T7:AE61]) Is Nothing Then
    If (Target.Value Like "1") Then
    ElseIf (Target.Value Like "2") Then
    ElseIf (Target.Value Like "3") Then
    ElseIf (Not Target.Value Like "") Then
          MsgBox "Please enter a rating of 1, 2 or 3."
        Application.EnableEvents = False
        Application.Undo

        Application.EnableEvents = True

    End If
      End If

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub

提前感谢您提供任何可能的帮助！

Answer 1

当他们执行填充时，Target是具有多个单元格的范围。因此，Target.Value Like "1"失败，因为您试图将变量数组与字符串进行比较。您需要做的是一次处理一个目标范围内的单个细胞。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range    'Added line

    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    If Not Intersect(Target, [A1:AE61]) Is Nothing Then
        For Each cell In Intersect(Target, [A1:AE61])    'Added line
            'Within this loop, I have replaced Target with cell
            If (cell.Value Like "1") Then
            ElseIf (cell.Value Like "2") Then
            ElseIf (cell.Value Like "3") Then
            ElseIf (Not cell.Value Like "") Then
                MsgBox "Please enter a rating of 1, 2 or 3."
                Application.EnableEvents = False
                Application.Undo

                Application.EnableEvents = True

            End If
        Next cell    'Added line
    End If

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

“运行时错误'13'仅在使用”填充“时？

1 个答案: