致杨萌《自制身份证查询系统》，另附批量查询模板

Cqy131

首先，你的窗体版《自制身份证查询系统》很方便，也很有创意，不过不能批量查询。

这份是我以前在百度文库里面下载的，里面的公式写的很详细。 EXCEL中-应用公式-提取身份证当中所包含的信息.rar (164.63 KB, 下载次数: 1058)

2014-6-5 17:19 上传

点击文件名下载附件

这份是我自己制作的模板，可以批量查询。可惜没有窗体，看起来不够高上大。 从身份证号码中提取信息.rar (446.19 KB, 下载次数: 1509)

2014-6-5 17:22 上传

点击文件名下载附件

如果你的模板能增加一个批量查询功能会更好哦。

Cqy131

oughouz 发表于 2014-6-5 19:38
谢谢楼主共享

客气了，前辈。

xnngyu680

谢谢老大，太历害了,谢谢分享

Cqy131

xnngyu680 发表于 2014-6-10 09:37
谢谢老大，太历害了,谢谢分享

百度文库里面的那份公式确实非常厉害，感谢那些高手的无私奉献

杰森one

能否留下联系方式，我现在在做设备查询，谢谢

Cqy131

杰森one 发表于 2014-6-10 20:26
能否留下联系方式，我现在在做设备查询，谢谢

可以加我的QQ，模板里面有

gun0080

想把这个功能加到我做的系统里，你能公开代码吗？

Cqy131

gun0080 发表于 2014-8-11 00:11
想把这个功能加到我做的系统里，你能公开代码吗？

Sub 从身份证号码中提取信息()
    m = Cells(1, 10).Value
    If m > 1 Then
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=LEN(RC[-1])"
    Range("C2").Select
    Selection.FormulaArray = _
        "=OR(LEN(RC[-2])=15,IF(LEN(RC[-2])=18,MID(""10X98765432"",MOD(SUM(MID(RC[-2],ROW(INDIRECT(""1:17"")),1)*2^(18-ROW(INDIRECT(""1:17"")))),11)+1,1)=RIGHT(RC[-2])))"
    Range("D2").Select
    Selection.FormulaArray = _
        "=IF(LEN(RC[-3])=15,REPLACE(RC[-3],7,,19)&MID(""10X98765432"",MOD(SUM(MID(REPLACE(RC[-3],7,,19),ROW(INDIRECT(""1:17"")),1)*2^(18-ROW(INDIRECT(""1:17"")))),11)+1,1),RC[-3])"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(MOD(RIGHT(LEFT(RC[-4],17)),2),""男"",""女"")"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
        "=DATE(MID(RC[-5],7,IF(LEN(RC[-5])=18,4,2)),MID(RC[-5],IF(LEN(RC[-5])=18,11,9),2),MID(RC[-5],IF(LEN(RC[-5])=18,13,11),2))"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-6]<>"""",DATEDIF(TEXT((LEN(RC[-6])=15)*19&MID(RC[-6],7,6+(LEN(RC[-6])=18)*2),""#-00-00""),TODAY(),""y""),)"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]<>"""",VLOOKUP(LEFT(RC[-7],2),地址码!C[-7]:C[-6],2,),)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-8]<>"""",VLOOKUP(LEFT(RC[-8],6),地址码!C[-8]:C[-7],2,),)"
    If m > 2 Then
    Range("B2:I2").Select
    Selection.AutoFill Destination:=Range(Cells(2, 2), Cells(m, 9)), Type:=xlFillDefault
    End If
    Range(Cells(2, 2), Cells(m, 9)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Else
    MsgBox "请在A列输入您要查找的身份证号码。", vbOKOnly, "相知_相遇 QQ：280027432"
    Cells(2, 1).Select
    End If
End Sub
Sub 清空()
    If MsgBox("您确定要清空吗？", vbQuestion + vbYesNo, "相知_相遇 QQ：280027432") = vbYes Then
    Columns("A:I").Select
    Selection.ClearContents
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "身份证号码"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "位数"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "是否正确"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "18位身份证号"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "性别"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "出生日期"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "年龄"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "所属省份"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "所属地区"
    End If
    Range("A2").Select
End Sub

日月星辰xu

赞同，非常感谢楼主的分享！

Cqy131

日月星辰xu 发表于 2014-8-11 20:25
赞同，非常感谢楼主的分享！

谢谢你的支持