[已解决]身份证信息模块出错，求修改

icenotcool

Sub 提取身份证信息()
Application.ScreenUpdating = False
Dim i As Integer
Dim iLastrow As Integer
iLastrow = Range("a" & Rows.Count).End(xlUp).Rows
For i = 2 To iLastrow
     Cells(i, 3).Value = IIf(Mid(Cells(i, 1).Value, 15, 3) Mod 2, "男", "女")
    Cells(i, 4).Value = DateSerial(Mid(Cells(i, 1).Value, 7, 4), _
                                  Mid(Cells(i, 3).Value, 11, 2), _
                                  Mid(Cells(i, 3).Value, 13, 2))
     Cells(i, 5).Value = DateDiff("yyyy", Cells(i, 4).Value, Date)
   Next i
   Application.ScreenUpdating = True
End Sub
附件.rar (12.01 KB, 下载次数: 16)

2016-12-22 11:10 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-12-22 11:47

1. Sub 提取身份证信息()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i As Integer, Sdate As Date
   
4.     Dim iLastrow As Integer
   
5.     iLastrow = Range("a" & Rows.Count).End(xlUp).Row
   
6.     For i = 2 To iLastrow
   
7.         Cells(i, 3).Value = IIf(Mid(Cells(i, 1).Value, 15, 3) Mod 2, "男", "女")
   
8.         Sdate = Format(Mid(Cells(i, 1).Value, 7, 8), "0000-00-00")
   
9.         Cells(i, 4).Value = Sdate
   
10.         Cells(i, 5).Value = DateDiff("yyyy", Sdate, Date)
    
11.     Next i
    
12.     Application.ScreenUpdating = True
    
13. End Sub

复制代码

跳转到最佳答案楼层

苏子龙

1. Sub 提取身份证信息()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i As Integer, Sdate As Date
   
4.     Dim iLastrow As Integer
   
5.     iLastrow = Range("a" & Rows.Count).End(xlUp).Row
   
6.     For i = 2 To iLastrow
   
7.         Cells(i, 3).Value = IIf(Mid(Cells(i, 1).Value, 15, 3) Mod 2, "男", "女")
   
8.         Sdate = Format(Mid(Cells(i, 1).Value, 7, 8), "0000-00-00")
   
9.         Cells(i, 4).Value = Sdate
   
10.         Cells(i, 5).Value = DateDiff("yyyy", Sdate, Date)
    
11.     Next i
    
12.     Application.ScreenUpdating = True
    
13. End Sub

复制代码

icenotcool

苏子龙 发表于 2016-12-22 11:47

谢谢老师，问题解决了