根据身份证号码提取临近退休人员信息

wkfcoffee

想要达到的结果：根据sheet2  A2单元各输入的年份，从sheet1里遍历身份证号，自动计算出退休时间（男60岁，女55岁），退休年份与sheet2  A2输入的年份相同，则在A列自动写入对应的姓名，B列写入对应的性别，以此类推。用函数index+if+small+row我会做。只是近段时间跟着孙兴华的视频学vba，能看懂几句代码，但写代码的能力很菜鸟。想向各位高手请教一下，这个用vba如何做，谢谢！
根据身份证号码提取临近退休人员信息.rar (13.61 KB, 下载次数: 21)

2023-5-22 15:07 上传

点击文件名下载附件

盼盼198310

..............

zxsea_7426

附件供参考：
解压后两种格式：xls+xlsm

13610618372

我是小白，你看看合适吗

limonet

代码审核中。

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("adodb.connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data source=" & ThisWorkbook.FullName
    StrSQL = "Select 姓名,性别,身份证号 from [Sheet1$B:F] Where MID(身份证号,7,4)+IIF(性别='女',55,66)<=" & [A2]
    Range("A4").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

limonet

上一个66对男人不公平，改正为60
Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("adodb.connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data source=" & ThisWorkbook.FullName
    StrSQL = "Select 姓名,性别,身份证号 from [Sheet1$B:F] Where MID(身份证号,7,4)+IIF(性别='女',55,60)<=" & [A2]
    Range("A4").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

zxsea_7426

13610618372 发表于 2023-5-22 17:11
我是小白，你看看合适吗

全党

参与一下。。。。。。。。。。。。

全党

Sub shishi()
Dim brr()
arr = Sheets("sheet1").Range("a1").CurrentRegion
sy = Sheets("sheet2").Range("a2").Value
For i = 2 To UBound(arr)
    If (arr(i, 3) = "女" And sy - Split(arr(i, 7), "-")(0) = 55) Or _
    (arr(i, 3) = "男" And sy - Split(arr(i, 7), "-")(0) = 60) Then
        m = m + 1
        ReDim Preserve brr(1 To m)
        tx = sy & "-" & Split(arr(i, 7), "-")(1) & "-" & Split(arr(i, 7), "-")(2)
        brr(m) = Array(arr(i, 2), arr(i, 3), arr(i, 6), arr(i, 8), arr(i, 12), tx)
        
    End If
Next
With Sheets("sheet2")
.Range("a4:f10000").ClearContents
.Columns("a:f").NumberFormatLocal = "@"
.Range("a4").Resize(m, 6) = Application.Rept(brr, 1)
End With
End Sub