3

我正在研究一种解决方案，该解决方案将使用从标签读取信息的键盘仿真设备填充的数据填充 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
4

3 回答 3

4

使用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
于 2013-04-09T22:39:44.057 回答
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
于 2013-04-09T22:25:23.390 回答
0

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

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

于 2013-04-09T22:43:08.910 回答