数据验证到动态范围

时间:2019-05-22 04:22:42

标签: excel vba

我的Excel工作表中有一个名为“时间”的列。我想编写一个代码,以便每当用户在时间列中执行输入时,如果它是一个整数,则应该接受,但如果不是,则会弹出一个窗口,显示“仅允许数字”。另外,验证应该是动态的,即如果用户输入新条目,则应该自动验证下一行

enter image description here

enter image description here

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Target.Column = Range("Meeting Time").Column Then

    If Not (IsNumeric(Target.Value)) Then

        MsgBox "only numbers allowed"

        Target.Value = ""

        Target.Select
    End If

End If

End Sub

2 个答案:

答案 0 :(得分:0)

首先,您可以为想要的“时间”列创建一个范围名称,然后可以使用下面的示例代码。

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Column = Range("time").Column Then

      If Not (IsNumeric(Target.Value)) Then

        MsgBox "only numbers allowed"

        Target.Value = ""

        Target.Select

      End If

    End If

End Sub

enter image description here

答案 1 :(得分:0)

您可以尝试:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    '1. Check if the column that affected is B (change to the column you want)
    '2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
    If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
        'Check if target is numeric
        If Not IsNumeric(Target.Value) Then
            Call Clear(Target)
        End If
        'Check if target.offset(1,0) is numeric
        If Not IsNumeric(Target.Offset(1, 0).Value) Then
            Call Clear(Target.Offset(1, 0))
        End If
    End If

End Sub

Sub Clear(ByVal rng As Range)

    'Disable events in order to prevent code to re trigger when clear cell
    Application.EnableEvents = False
    rng.Value = ""
    'Enable events
    Application.EnableEvents = True

End Sub

编辑版本:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    '1. Check if the column that affected is B (change to the column you want)
    '2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
    If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
        'Check if target is numeric
        If Not IsNumeric(Target.Value) Then
            Call Clear(Target)
        ElseIf Target.Value > 160 Or (Target.Value = Int(Target.Value) = False) Then
             Call Clear(Target)
        End If
        'Check if target.offset(1,0) is numeric
        If Not IsNumeric(Target.Offset(1, 0).Value) Then
            Call Clear(Target.Offset(1, 0))
        ElseIf Target.Offset(1, 0).Value > 160 Or (Target.Offset(1, 0).Value = Int(Target.Offset(1, 0).Value) = False) Then
            Call Clear(Target)
        End If
    End If

End Sub

Sub Clear(ByVal rng As Range)

    'Disable events in order to prevent code to re trigger when clear cell
    Application.EnableEvents = False
    rng.Value = ""
    'Enable events
    Application.EnableEvents = True

End Sub