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活动

ViewCode

Worksheet

Select Change Event

Final Code

使用的代码是：

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

在活动中你想要测试更多的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

如果您要一次更改多个单元格，请使用此选项：

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

Answer 2

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

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

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

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

测试不同的列：

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

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

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

Answer 3

使用这样的东西可能有用。

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

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

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

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

3 个答案: