当细胞失去焦点时，可以测试excel细胞文本的长度吗？

I'm working on a solution that will fill excel cells with data being populated by a keyboard emulation device that reads information from tags. after the data is read the keyboard emulation device will send a postfix character like a TAB or CR to progress to a different cell

我正在研究一种解决方案，它将填充excel单元格，数据由键盘仿真设备填充，该设备从标签读取信息。在读取数据之后，键盘仿真设备将发送诸如TAB或CR之类的后缀字符以进入不同的单元

I'm trying to determine if it's possible using VBA to test the length of the data that was filled when that cell loses focus from the TAB/CR. if it's not the correct length I'd like to have the option to either delete the previous cell's contents or display a message box window telling the user there's an issue.

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

I really don't know where to start.

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

Any ideas?

有任何想法吗？

EDIT - Here's the code that's working for me.

编辑 - 这是为我工作的代码。

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

3 个解决方案

#1

Use the Worksheet_Change Event

使用Worksheet_Change事件

The code used was:

使用的代码是：

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

To test a different length for a different column just add an else for example

要测试不同列的不同长度，只需添加其他值即可

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

In the Event you'd like to test a larger amount of Columns it would be smart to change things around and add a function into your program as Follows:

在活动中你想要测试更多的Columns，你可以聪明地改变一些事情并在你的程序中添加一个函数，如下所示：

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

If you are going to change more then one cell at a time use this:

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

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

#2

The code below tests if the length of the text in the cell is not equal to 8, if so it presents the user with a message box. This is the Worksheet_Change event for the sheet where the data is being entered. Target is the range that was just edited:

下面的代码测试单元格中文本的长度是否不等于8，如果是这样，它会向用户显示一个消息框。这是输入数据的工作表的Worksheet_Change事件。目标是刚刚编辑的范围：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Len(Target.Text) <> 8 Then MsgBox "Hey something's wrong!"
End Sub

If you want to toggle this functionality off while doing other data entry on the same sheet I would suggest using a cell somewhere on the same sheet to tell the coding that you are in "scanner mode":

如果您想在同一张纸上进行其他数据输入时关闭此功能，我建议在同一张纸上使用某个单元格来告诉编码您处于“扫描仪模式”：

Private Sub Worksheet_Change(ByVal Target As Range)
    If [q1].value <> "" then 'if cell Q1 has any value in it, we are in "scanner mode"
        If Len(Target.Text) <> 8 Then MsgBox "Hey something's wrong!"
    End If
End Sub

To test different columns:

要测试不同的列：

Private Sub Worksheet_Change(ByVal Target As Range)
    If [q1].value <> "" then 'if cell Q1 has any value in it, we are in "scanner mode"
        If Target.Column = 1 then 'if column A do this:
            If Target.Row > 3 and Target.Row < 30 then 'between row 3 and 30
                If Len(Target.Text) <> 8 Then MsgBox "Hey something's wrong!"
            End If
        End If
        If Target.Column = 2 then 'if column B do this:
            If Target.Row > 5 and Target.Row < 50 then 'between row 5 and 50
                If Len(Target.Text) <> 10 Then MsgBox "Hey something's wrong!"
            End If
        End If
    End If
End Sub

As another enhancement you could ask the user if they want to correct what was entered by hand:

作为另一项增强功能，您可以询问用户是否要更正手动输入的内容：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sNewValue As String
    If Target.Cells.Count <> 1 Then Exit Sub 'if more than 1 cell was changed
    If [q1].Value <> "" Then 'if cell Q1 has any value in it, we are in "scanner mode"
        If Target.Column = 1 Then 'if column A do this:
            If Target.Row > 3 And Target.Row < 30 Then 'between row 3 and 30
                If Len(Target.Text) <> 8 Then
                    sNewValue = InputBox("The scanned value seems invalid, " & _
                        "Press Ok to accept the value or enter different one.", _
                        "Verify Value", Target.Value)
                    Application.EnableEvents = False
                    Target.Value = sNewValue
                    Application.EnableEvents = True
                End If
            End If
        End If
        If Target.Column = 2 Then 'if column B do this:
            If Target.Row > 5 And Target.Row < 50 Then 'between row 5 and 50
                sNewValue = InputBox("The scanned value seems invalid, " & _
                        "Press Ok to accept the value or enter different one.", _
                        "Verify Value", Target.Value)
                    Application.EnableEvents = False
                    Target.Value = sNewValue
                    Application.EnableEvents = True
            End If
        End If
    End If
End Sub

#3

Using something like this might work.

使用这样的东西可能会奏效。

Private PreviousSelection As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not PreviousSelection Is Nothing Then
' you have a previous selection, do stuff to it here
End If

Set PreviousSelection = Target

End Sub

If your keyboard emulator is sending keys really fast it might struggle though!

如果您的键盘模拟器发送键非常快，它可能会很困难！

If your emulator keeps sending data even after a tab or cr (multiple cells etc) then you will not be able to have a message box to display an error due to the messagebox taking focus away from the worksheet.

如果您的模拟器即使在制表符或cr（多个单元格等）之后仍然继续发送数据，那么由于消息框将焦点从工作表中移开，您将无法显示错误消息框。