|
发表于 2011-8-19 21:40
|
显示全部楼层
本楼为最佳答案
yjwdjfqb 发表于 2011-8-19 21:21
回复 放浪形骸 的帖子
老师,帮忙把修改的代码传一个好吧
唉。我本意是授人以鱼不如授人以渔,既然你不想动脑,那就算了。直接给代码吧- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim iRng As Range, iLen%, iDate$, iDate1$, tmp$
- Application.EnableEvents = False
- If Cells(3, Target.Column).Value = "身份证号码" Then
- Set iRng = Range(Cells(5, Target.Column), Cells(15, Target.Column))
- iRng.NumberFormatLocal = "@"
- tmp = Target.Value
- If tmp <> "" Then
- iLen = Len(tmp)
- If iLen = 15 Then
- iDate = "19" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
- iDate1 = "20" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
- If Not IsNumeric(tmp) Then
- MsgBox "当前输入 " & tmp & " 不是正确的身份证号码!", , "身份证录入系统"
- Target.Value = ""
- ElseIf (Not IsDate(iDate)) And (Not IsDate(iDate1)) Then
- MsgBox "当前输入 " & tmp & " 不是正确的身份证号码!", , "身份证录入系统"
- Target.Value = ""
- End If
- ElseIf iLen = 18 Then
- iDate = Mid(tmp, 7, 4) & "/" & Mid(tmp, 11, 2) & "/" & Mid(tmp, 13, 2)
- If Not IsNumeric(tmp) Then
- If (Not IsDate(iDate)) Or (Not IsNumeric(Left(tmp, iLen - 1))) Or (Right(tmp, 1) <> "X") Then
- MsgBox "当前输入 " & tmp & " 不是正确的身份证号码!", , "身份证录入系统"
- Target.Value = ""
- End If
- Else
- If Not IsDate(iDate) Then
- MsgBox "当前输入 " & tmp & " 不是正确的身份证号码!", , "身份证录入系统"
- Target.Value = ""
- End If
- End If
- Else
- MsgBox "当前输入 " & iLen & " 位,请输入15位或者18位!", , "身份证录入系统"
- Target.Value = ""
- End If
- End If
- End If
- 1000:
- If Application.ErrorCheckingOptions.NumberAsText Then
- Application.ErrorCheckingOptions.NumberAsText = False
- End If
- Application.EnableEvents = True
- End Sub
复制代码 |
|