[已解决]VBA＿请大家修改下这个代码＿工作表事件

yjwdjfqb

VBA＿请大家修改下这个代码＿工作表事件


这是一个防止身份证号码输入时格式出现错误的事件。
B3为“身份证号码”时，就把B5:B15的单元格格式为“文本”，并且激活防止身份证输入错误的事件，否则其格式为“常规”不激活事件。
D3为“身份证号码”时，就把D5:D15的单元格格式为“文本”，并且激活防止身份证输入错误的事件，否则其格式为“常规”不激活事件。

问题，激活防止身份证输入错误的事件没有起到作用。

请大家见附件

最佳答案

月排行榜 / 总排行榜

放浪形骸

2011-8-19 21:40

yjwdjfqb 发表于 2011-8-19 21:21
回复 放浪形骸 的帖子

老师，帮忙把修改的代码传一个好吧

唉。我本意是授人以鱼不如授人以渔，既然你不想动脑，那就算了。直接给代码吧

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim iRng As Range, iLen%, iDate$, iDate1$, tmp$
   
3. Application.EnableEvents = False
   
4. If Cells(3, Target.Column).Value = "身份证号码" Then
   
5.     Set iRng = Range(Cells(5, Target.Column), Cells(15, Target.Column))
   
6.     iRng.NumberFormatLocal = "@"
   
7.     tmp = Target.Value
   
8.     If tmp <> "" Then
   
9.         iLen = Len(tmp)
   
10.         If iLen = 15 Then
    
11.             iDate = "19" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
    
12.             iDate1 = "20" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
    
13.             If Not IsNumeric(tmp) Then
    
14.                 MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
15.                 Target.Value = ""
    
16.             ElseIf (Not IsDate(iDate)) And (Not IsDate(iDate1)) Then
    
17.                 MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
18.                 Target.Value = ""
    
19.             End If
    
20.         ElseIf iLen = 18 Then
    
21.             iDate = Mid(tmp, 7, 4) & "/" & Mid(tmp, 11, 2) & "/" & Mid(tmp, 13, 2)
    
22.             If Not IsNumeric(tmp) Then
    
23.                 If (Not IsDate(iDate)) Or (Not IsNumeric(Left(tmp, iLen - 1))) Or (Right(tmp, 1) <> "X") Then
    
24.                     MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
25.                     Target.Value = ""
    
26.                 End If
    
27.             Else
    
28.                 If Not IsDate(iDate) Then
    
29.                     MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
30.                     Target.Value = ""
    
31.                 End If
    
32.             End If
    
33.         Else
    
34.             MsgBox "当前输入 " & iLen & " 位，请输入15位或者18位！", , "身份证录入系统"
    
35.             Target.Value = ""
    
36.         End If
    
37.     End If
    
38. End If
    
39. 1000:
    
40.     If Application.ErrorCheckingOptions.NumberAsText Then
    
41.         Application.ErrorCheckingOptions.NumberAsText = False
    
42.     End If
    
43.     Application.EnableEvents = True
    
44. End Sub

复制代码

跳转到最佳答案楼层

放浪形骸

我感觉你的思路有问题。
因为你所有的worksheet_change()事件运行的前提就是

1. If Target.Address = "$B$3" Or Target.Address = "$D$3" Then

复制代码

这个成立。
而你接下来在B3或D3下输入的内容，发生的change事件由于条件判断了之后，发现target的地址不符合你的要求，那么就会结束掉这个SUB，所以就不会激活后面的判断过程了。

放浪形骸

一种思路就是：
分两步走：
1、如果是B3或者D3发生改变，那么就调整对应的B5:B15或D5:D15的单元格格式（这个是第一个IF）
2、若是其他的单元格发生改变，先判断这个单元格所在的列的第三个单元格是“身份证号码”这几个字么？如果是，那么就进入接下来的身份证号码判断过程（这个是第二个IF，或者说算是ELSE IF）

放浪形骸

yjwdjfqb 发表于 2011-8-18 22:27
VBA＿请大家修改下这个代码＿工作表事件

明白了么？

yjwdjfqb

放浪形骸 发表于 2011-8-18 23:09
一种思路就是：
分两步走：
1、如果是B3或者D3发生改变，那么就调整对应的B5:B15或D5:D15的单元格格式（这 ...

本人是菜鸟一个哟，还没有搞明白

放浪形骸

yjwdjfqb 发表于 2011-8-19 00:41
本人是菜鸟一个哟，还没有搞明白

就是把这个步骤分成两个步骤来解决

yjwdjfqb

回复 放浪形骸 的帖子

老师，帮忙把修改的代码传一个好吧

放浪形骸

yjwdjfqb 发表于 2011-8-19 21:21
回复 放浪形骸 的帖子

老师，帮忙把修改的代码传一个好吧

其实，我前面说的方法你根本就没去看。

放浪形骸

yjwdjfqb 发表于 2011-8-19 21:21
回复 放浪形骸 的帖子

老师，帮忙把修改的代码传一个好吧

唉。我本意是授人以鱼不如授人以渔，既然你不想动脑，那就算了。直接给代码吧

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim iRng As Range, iLen%, iDate$, iDate1$, tmp$
   
3. Application.EnableEvents = False
   
4. If Cells(3, Target.Column).Value = "身份证号码" Then
   
5.     Set iRng = Range(Cells(5, Target.Column), Cells(15, Target.Column))
   
6.     iRng.NumberFormatLocal = "@"
   
7.     tmp = Target.Value
   
8.     If tmp <> "" Then
   
9.         iLen = Len(tmp)
   
10.         If iLen = 15 Then
    
11.             iDate = "19" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
    
12.             iDate1 = "20" & Mid(tmp, 7, 2) & "/" & Mid(tmp, 9, 2) & "/" & Mid(tmp, 11, 2)
    
13.             If Not IsNumeric(tmp) Then
    
14.                 MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
15.                 Target.Value = ""
    
16.             ElseIf (Not IsDate(iDate)) And (Not IsDate(iDate1)) Then
    
17.                 MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
18.                 Target.Value = ""
    
19.             End If
    
20.         ElseIf iLen = 18 Then
    
21.             iDate = Mid(tmp, 7, 4) & "/" & Mid(tmp, 11, 2) & "/" & Mid(tmp, 13, 2)
    
22.             If Not IsNumeric(tmp) Then
    
23.                 If (Not IsDate(iDate)) Or (Not IsNumeric(Left(tmp, iLen - 1))) Or (Right(tmp, 1) <> "X") Then
    
24.                     MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
25.                     Target.Value = ""
    
26.                 End If
    
27.             Else
    
28.                 If Not IsDate(iDate) Then
    
29.                     MsgBox "当前输入 " & tmp & " 不是正确的身份证号码！", , "身份证录入系统"
    
30.                     Target.Value = ""
    
31.                 End If
    
32.             End If
    
33.         Else
    
34.             MsgBox "当前输入 " & iLen & " 位，请输入15位或者18位！", , "身份证录入系统"
    
35.             Target.Value = ""
    
36.         End If
    
37.     End If
    
38. End If
    
39. 1000:
    
40.     If Application.ErrorCheckingOptions.NumberAsText Then
    
41.         Application.ErrorCheckingOptions.NumberAsText = False
    
42.     End If
    
43.     Application.EnableEvents = True
    
44. End Sub

复制代码

yjwdjfqb

回复 放浪形骸 的帖子

感谢老师