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

possible to test the length of an excel cell's text as the cell loses focus?

提问by alexsd

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

回答by user2140261

Use the Worksheet_ChangeEvent

使用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 elsefor example

要测试不同列的不同长度，只需添加一个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

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:

在事件中，您想测试更多的列，明智的做法是更改一些内容并将函数添加到您的程序中，如下所示：

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

回答by Ross McConeghy

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

回答by NickSlash

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（多个单元格等）之后仍继续发送数据，那么您将无法让消息框显示错误，因为消息框将焦点从工作表上移开。