"Run-time error '13' only when "填下来”用过？

Question

以下代码旨在仅允许在单元格区域中输入 1、2 或 3。如果输入了其他内容，则会弹出错误消息并撤消输入。除非用户填写他们的回复，否则代码可以完美运行。那时， "run-time error '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

"Run-time error '13' only when "填下来”用过？

"Run-time error '13' only when "Fill down" used?

excel

vba

runtime-error