VB编程Excel检查数据输入重复以及自动保存怎么写？
非常感谢你！不过现在还有一个问题。我根据你的提示自己完善了程序如下：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then '如果单元格不是A列
If Target.Value = "" Then Exit Sub '如果单元格为空则忽略
s = Left(Target.Value, 6) '取单元格左边4位数
If s <> "131754" Then '如果网标码左边的6位数不是131754则显示错误
MsgBox "输入错误！请检查当前输入类别！"
Target.Select
Target.Value = ""
Else
Cells(Target.Row, Target.Column + 1).Select
End If
End If
If Target.Column = 2 Then
If Target.Value = "" Then Exit Sub '如果单元格为空则忽略
s = Left(Target.Value, 6) '取单元格左边4位数
If s <> "860584" Then '如果imei左边的6位数不是860584则显示错误
MsgBox "输入错误！请检查当前输入类别！"
Target.Select
Target.Value = ""
Else
Cells(Target.Row + 1, Target.Column - 1).Select
End If
End If
End Sub
现在还需一个检查重复的功能，就是就是在检查输入正确性同时还要检查当前输入是否重复，如果是就要提示输入重复并重新输入。另外每次正确输入后是否能自动保存一下，防止意外。感谢！
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追问
我把你的代码复制到Excel复制到vb编辑器中提示错误啊！ If (.Column = 1 And s "131754") _
Or (.Column = 2 And s "860584") Then
这一句有问题。
把_删除掉，把下句（or(.Column)）移上去试试。
" _ "是把一条语句分成上下两行的标示符。
我这里运行发现重复时缺少提示，修改如下：
.......
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
.Offset(0, 1).Select
Else
'Cells(.Row + 1, .Column - 1).Select
.Offset(1, -1).Select
End If
ThisWorkbook.Save
Else ' -------这一部分是后面添加的
MsgBox "输入重复"
.Select
.Value = "" '----------------
End If
End If
End If
End With
End Sub
感谢！我把你的都复制过去了，但是貌似没有任何效果。我输入后没有任何提示，输入框也不能控制。我以前的那个程序是可以的。不知道是哪里的问题。
追答我的代码是以第1列和第2列（即A、B列）为参考的，如果你的数据在其它列，需要做相应修改。
If .Column = 1 Or .Column = 2 Then
If (.Column = 1 And s "131754") Or (.Column = 2 And s "860584") Then
以上两句里的.column值得改。
这是我复制的代码，没什么问题啊！我的也是记录A，B列。但是就是没有任何效果。不知道哪里出问题了。麻烦帮帮我，谢谢了！
代码没发现问题，注意存放位置。
1、下面的一段是事件：
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim s As String
....
end sub
放置位置：
双击左侧树上的"ThisWorkbook"，粘贴到右侧编辑窗口，右侧窗口的两个下拉框里应该显示为“workbook”和“SheetChange”
2、下面的代码是函数，要放在模块里：
Function IsRepeat(ByVal Target As Range, ByVal lngBeginRow As Long) As Boolean
操作方法：在左侧“ThisWorkbook”节点下面空白的地方右击鼠标，选择“插入”－模块
改了一下你的代码
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追问
你好，感谢你的帮助。但是你代码中没有检查重复啊？你说的那些我不懂啊！
本回答被网友采纳