[已解决]关于VBA事件，表述方式

yjwdjfqb

关于VBA事件，表述方式

不好表述，画了个图，请老师们帮帮解决下，谢谢大家了！



关于VBA事件，表述方式.rar (8.32 KB, 下载次数: 8)

2014-4-19 00:27 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-4-19 08:17

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. 'If Target.Column = 9 And Target.Row > 1 Then
   
3. 
   
4.     On Error Resume Next
   
5.    
   
6.     If (Not Intersect(Target, Range("G2:G10")) Is Nothing) Then
   
7.         Application.EnableEvents = False
   
8.         num = Target.Value
   
9. 
   
10.         If Len(num) = 0 Then
    
11.             Range("j" & Target.Row).Value = ""
    
12.             Range("l" & Target.Row).Value = ""
    
13.             '或者cells(target.row,"j").value=""
    
14.             'cells(target.row,"l").value=""
    
15. 
    
16.             GoTo quit1
    
17.         End If
    
18. 
    
19.         If Len(Trim(num)) <> 18 Then: GoTo quit1    '号码不是18位,则退出
    
20. 
    
21.         yy = Mid(num, 7, 4)    '从第7个字符开始,连续4个字符(以下同理)
    
22.         mm = Mid(num, 11, 2)
    
23.         dd = Mid(num, 13, 2)
    
24. 
    
25. 
    
26.         Cells(Target.Row, "j").Value = DateSerial(yy, mm, dd)
    
27.         Cells(Target.Row, "l").Value = "=YEAR(NOW())-YEAR(J" & Target.Row & ")"
    
28.     End If
    
29. quit1:
    
30.     Application.EnableEvents = True
    
31. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. 'If Target.Column = 9 And Target.Row > 1 Then
   
3. 
   
4.     On Error Resume Next
   
5. 
   
6.     If (Not Intersect(Target, Range("G2:G10")) Is Nothing) Then
   
7.         Application.EnableEvents = False
   
8.         num = Target.Value
   
9. 
   
10.         If Len(num) = 0 Then Range("j" & Target.Row & ":l" & Target.Row).Value = "": GoTo quit1
    
11. 
    
12.         If Len(Trim(num)) <> 18 Then: GoTo quit1    '号码不是18位,则退出
    
13. 
    
14.         yy = Mid(num, 7, 4)    '从第7个字符开始,连续4个字符(以下同理)
    
15.         mm = Mid(num, 11, 2)
    
16.         dd = Mid(num, 13, 2)
    
17. 
    
18. 
    
19.         Cells(Target.Row, "j").Value = DateSerial(yy, mm, dd)
    
20.         Cells(Target.Row, "l").Value = "=YEAR(NOW())-YEAR(RC[-2])"
    
21.     End If
    
22. quit1:
    
23.     Application.EnableEvents = True
    
24. End Sub
    

复制代码

yjwdjfqb

hwc2ycy 发表于 2014-4-19 00:40

版主就是这样的，非常感谢，

"=YEAR(NOW())-YEAR(RC[-2])"　这句中的　[-2］ 能改在那样的吗，也就是j列的对应单元格

yjwdjfqb

hwc2ycy 发表于 2014-4-19 00:40

If Len(num) = 0 Then Range("j" & Target.Row & ":l" & Target.Row).Value = "": GoTo quit1


这个当，　为　0时，，　　这个地方，改是　对应的J单元格　　对应的I单元格　为空。　

不是J：I之间的区域为空
麻烦老师改改好吧！

谢谢啦　！

hwc2ycy

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. 'If Target.Column = 9 And Target.Row > 1 Then
   
3. 
   
4.     On Error Resume Next
   
5.    
   
6.     If (Not Intersect(Target, Range("G2:G10")) Is Nothing) Then
   
7.         Application.EnableEvents = False
   
8.         num = Target.Value
   
9. 
   
10.         If Len(num) = 0 Then
    
11.             Range("j" & Target.Row).Value = ""
    
12.             Range("l" & Target.Row).Value = ""
    
13.             '或者cells(target.row,"j").value=""
    
14.             'cells(target.row,"l").value=""
    
15. 
    
16.             GoTo quit1
    
17.         End If
    
18. 
    
19.         If Len(Trim(num)) <> 18 Then: GoTo quit1    '号码不是18位,则退出
    
20. 
    
21.         yy = Mid(num, 7, 4)    '从第7个字符开始,连续4个字符(以下同理)
    
22.         mm = Mid(num, 11, 2)
    
23.         dd = Mid(num, 13, 2)
    
24. 
    
25. 
    
26.         Cells(Target.Row, "j").Value = DateSerial(yy, mm, dd)
    
27.         Cells(Target.Row, "l").Value = "=YEAR(NOW())-YEAR(J" & Target.Row & ")"
    
28.     End If
    
29. quit1:
    
30.     Application.EnableEvents = True
    
31. End Sub
    

复制代码

hwc2ycy

就差多单元格没考虑了。

yjwdjfqb

hwc2ycy 发表于 2014-4-19 08:17

Cells(Target.Row, "n").Value = "=IF(MOD(IF(LEN(g" & Target.Row & ")=15,MID(g" & Target.Row & ",15,1),MID(g" & Target.Row & ",17,1)),2)=1,""男"",""女""))"


版主，帮帮看看，我这个加了一个，生成性别的

为什么不成功，谢谢了！

hwc2ycy

1. Cells(Target.Row, "n").Value = "=if(MOD(IF(LEN(g" & Target.Row & ")=15,MID(g" & Target.Row & ",15,1),MID(g" & Target.Row & ",17,1)),2),""男"",""女"")"

复制代码

yjwdjfqb

hwc2ycy 发表于 2014-4-19 11:00

哦，原来多了个){:011:}