当细胞失去焦点时可以testing一个excel细胞文本的长度？
我正在研究一个解决scheme，将填充excel单元格的数据由键盘仿真设备从标签读取信息填充。 在读取数据之后，键盘仿真设备将发送像TAB或CR这样的后缀字符以前进到不同的单元
我试图确定是否有可能使用VBA来testing填充的数据的长度，当单元失去焦点从TAB / CR。 如果不是正确的长度，我想要select删除以前的单元格的内容或显示一个消息框窗口告诉用户有一个问题。
我真的不知道从哪里开始。
有任何想法吗？
编辑 – 这是为我工作的代码。
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 使用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
要testing不同列的不同长度，只需添加一个例如
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
在这个事件中，你想testing更多的列，那么改变它们并在程序中添加一个函数是很明智的，如下所示：
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
下面的代码testing单元格中的文本的长度是否不等于8，如果是这样，则向用户呈现消息框。 这是input数据的工作表的Worksheet_Change事件。 目标是刚刚编辑的范围：
Private Sub Worksheet_Change(ByVal Target As Range) If Len(Target.Text) <> 8 Then MsgBox "Hey something's wrong!" End Sub
如果您想在同一张纸上进行其他数据input时closures此function，我build议您使用同一张纸上的某个单元格来告诉编码您处于“扫描仪模式”：
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
要testing不同的列：
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
作为另一个增强function，您可以询问用户是否要纠正手动input的内容：
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
使用这样的东西可能会奏效。
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
如果你的键盘模拟器真的很快发送键，它可能会很困难！
如果你的模拟器在一个tab或者cr（多个单元格等）之后仍然在发送数据，那么你将不能有一个消息框来显示一个错误，因为这个消息箱把焦点从工作表中移开了。