'SheetChange事件,在单元格数值改变时触发
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim s As String
With Target '为减少对象调用,使用With语句
If .Value = "" Then Exit Sub '值为空,退出
s = Left(Format(.Value), 6) '取单元格左边6位数
If .Column = 1 Or .Column = 2 Then
If (.Column = 1 And s <> "131754") _
Or (.Column = 2 And s <> "860584") Then '如果网标码左边的6位数不是131754则显示错误
MsgBox "输入错误!请检查当前输入类别!"
.Select
.Value = ""
Else
If Not IsRepeat(Target, 2) Then '检查当前列是否有重复数值(从第2行开始检查)
If .Column = 1 Then
Cells(.Row, .Column + 1).Select
Else
Cells(.Row + 1, .Column - 1).Select
End If
ThisWorkbook.Save '保存文件
End If
End If
End If
End With
End Sub
'下面的代码插入到模块,检查同列是否有重复数值
Function IsRepeat(ByVal Target As Range, ByVal lngBeginRow As Long) As Boolean
Dim strCol As String, strRow As String, lngEndRow As Long, curValue
Dim s(), countMemo As Long, cx As Long
Dim intRep As Integer
If lngBeginRow < 1 Then Exit Function
'输入的值
curValue = Target.Value
'当前列所有值放入数值,并计算数值长度
strRow = Format(lngBeginRow)
strCol = Replace(Replace(Cells(1, Target.Column).Address, "$", ""), "1", "")
lngEndRow = ActiveSheet.UsedRange.Rows.Count
s = Range(strCol & strRow & ":" & strCol & Format(lngEndRow))
countMemo = UBound(s)
'检查是否有重复值
For cx = 1 To countMemo
If curValue = s(cx, 1) Then
intRep = intRep + 1
If intRep = 2 Then'有重复数值返回为True
IsRepeat = True
Exit Function
End If
End If
Next
End Function
重复性问题用数据有效性解决,选 中AB2列,有效性条件 为 自定义--公式 输入=COUNTIF(A:B,A1)=1
改了一下你的代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value <> "" Then
s = Left(Target.Value, 6)
If s <> "131754" Then
GoTo 1
Else
Target.Offset(0, 1).Select
ThisWorkbook.Save
End If
End If
If Target.Column = 2 And Target.Value <> "" Then
s = Left(Target.Value, 6)
If s <> "860584" Then
GoTo 1
Else
Target.Offset(1, -1).Select
ThisWorkbook.Save
End If
End If
Exit Sub
1:
MsgBox "输入错误!请检查当前输入类别!"
With Target
.Select
.Value = ""
End With
End Sub