vba - 当单元格失去焦点时，可以测试 Excel 单元格文本的长度吗？

Question

我正在开发一种解决方案，该解决方案将使用从标签读取信息的键盘模拟设备填充的数据填充 Excel 单元格。读取数据后，键盘模拟设备将发送一个后缀字符(如 TAB 或 CR)以前进到不同的单元格

我正在尝试确定是否可以使用 VBA 来测试当该单元格从 TAB/CR 失去焦点时填充的数据的长度。如果长度不正确，我希望可以选择删除前一个单元格的内容或显示一个消息框窗口，告诉用户存在问题。

我真的不知道从哪里开始。

有什么想法吗？

编辑- 这是对我有用的代码。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iLen As Integer

If Target.Cells.Count > 1 Then Exit Sub ' bail if more than one cell selected

iLen = Len(Target.Value)    ' get cell data length
If iLen = 0 Then Exit Sub   ' bail if empty data

If Target.Column = 1 Then ' if Col A
    If Target.Row = 1 Then Exit Sub ' bail if column header
    If iLen <> 3 Then 'Replace *Your Value* with your length
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False 'So we don't get an error while clearing
        Target.Offset(0, 0).Value = ""
        Target.Offset(0, 0).Select
        Application.EnableEvents = True ' So Excel while function normal again
    End If
ElseIf Target.Column = 2 Then ' if Col B
    If Target.Row = 1 Then Exit Sub ' bail if column header
    If iLen <> 7 Then
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False
        Target.Offset(0, 0).Value = ""
        Target.Offset(0, 0).Select
        Application.EnableEvents = True
    End If
End If
End Sub

Answer 1

使用Worksheet_Change事件

使用的代码是:

If Target.Column = 1 Then
    If Len(Target.Value) <> 3 Then 'Replace *Your Value* with your length
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False 'So we don't get an error while clearing
        Target.Offset(-1, 0).Value = ""
        Target.Offset(-1, 0).Select
        Application.EnableEvents = True ' So Excel will function normal again
    End If
End If

要测试不同列的不同长度，只需添加 else 例如

If Target.Column = 1 Then
    If Len(Target.Value) <> 3 Then 'Replace *Your Value* with your length
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False 'So we don't get an error while clearing
        Target.Offset(-1, 0).Value = ""
        Target.Offset(-1, 0).Select
        Application.EnableEvents = True ' So Excel will function normal again
    End If
Else If Target.Column = 2 then
    If Len(Target.Value) <> 7 Then 
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False 
        Target.Offset(-1, 0).Value = ""
        Target.Offset(-1, 0).Select
        Application.EnableEvents = True 
    End If

End If

如果您想测试大量的列，明智的做法是改变周围的情况并向您的程序添加一个函数，如下所示:

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Column

        Case 1 'If Target.Column = A
            Call TestValues(Target.Value, 3)
        Case 2 'If Target.Column = B
            Call TestValues(Target.Value, 7)
        Case 7 'If Target.Column = G
            Call TestValues(Target.Value, 1)

    End Select

End Sub

Function TestValues(CellValue As String, LengthLimit As Integer)

    If Len(CellValue) <> LengthLimit Then 'The value and length passed in from the Call Method
        MsgBox "You have entered an incorrect Value"
        Application.EnableEvents = False 'So we don't get an error while clearing
        Target.Offset(-1, 0).Value = ""
        Target.Offset(-1, 0).Select
        Application.EnableEvents = True ' So Excel will function normal again
    End If

End Function

如果您要一次更改多个单元格，请使用以下命令:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ChangedCell As Range
    For Each ChangedCell In Target.Cells
        Select Case ChangedCell.Column
            Case 1 'If Target.Column = A
                Call TestValues(ChangedCell, 3)
            Case 2 'If Target.Column = B
                Call TestValues(ChangedCell, 7)
            Case 7 'If Target.Column = G
                Call TestValues(ChangedCell, 1)
        End Select
    Next ChangedCell
End Sub
Function TestValues(curCell As Range, LengthLimit)
        If Len(curCell.Value) <> LengthLimit Then 'The value and length passed in from the Call Method
            MsgBox "You have entered an incorrect Value"
            Application.EnableEvents = False 'So we don't get an error while clearing
            curCell.Value = ""
            curCell.Select
            Application.EnableEvents = True ' So Excel will function normal again
        End If
End Function