关于在excel中实现身份证15变18的设置问题。

我去上自习

             因工作需要，需要把身份证15位变18位，而且在返回的18位身份证反馈出对应的姓名。（手上有人口信息 ）  图片有图

lb-linbin

最好上传一个附件

qy1219no2

1. Function idCode(sCode As String) As String
   
2.     Dim i%, num%, Code As String
   
3.     idCode = "错误号码！"
   
4.     If Len(sCode) <> 15 Or (Not IsNumeric(Left(sCode, 8))) Or _
   
5.         (Not IsNumeric(Right(sCode, 8))) Then _
   
6.         MsgBox "你输入的身份证号码不对！", vbCritical, "错误": Exit Function
   
7.     sCode = Left(sCode, 6) & "19" & Right(sCode, 9)
   
8.     csDate = Mid(sCode, 7, 8)
   
9.     csDate = Format(csDate, "0000-00-00")
   
10.     If IsDate(csDate) = False Then _
    
11.         MsgBox "你输入的号码不符合要求，请检查！": Exit Function
    
12.     idCode = sCode
    
13.     For i = 18 To 2 Step -1
    
14.         num = num + (2 ^ (i - 1) Mod 11) * (Mid(idCode, 19 - i, 1))
    
15.     Next
    
16.     num = num Mod 11
    
17.     Code = IIf(num = 0, "1", IIf(num = 1, "0", _
    
18.            IIf(num = 2, "X", Trim(Str(12 - num)))))
    
19.     idCode = idCode + Code
    
20. End Function

复制代码

将上述代码写入VBA代码编辑器中，然后在需要调用的时候，用

1. TextBox2.text=idCode(Textbox1.text)
   

复制代码

至于查找姓名，由于没有看到具体信息，无法实现

qy1219no2

假设姓名在Sheet2表的B列，C列为身份证号码，可以如下代码实现：

1. If TextBox2.Text <> "" Then
   
2.     Set Xm = Sheet2.[C:C].Find(TextBox2.Text)
   
3.     If Not Xm Is Nothing Then TextBox3.Text = Sheet2.Cells(Xm.Row, 2)
   
4.     Set Xm = Nothing
   
5. End If

复制代码

我去上自习

上传了附件。高手帮忙弄一下

我去上自习

qy1219no2 发表于 2013-4-28 15:25
将上述代码写入VBA代码编辑器中，然后在需要调用的时候，用

至于查找姓名，由于没有看到具体信息，无法实 ...

高人。附件在楼下。帮我弄一哈子

qy1219no2

我去上自习 发表于 2013-4-28 15:35
高人。附件在楼下。帮我弄一哈子

请看附件……………………