想要把身份证号的列，用规则限定

安永飞

用VBA,D盘里有一个“玉米大豆水稻补贴”文件夹，这个文件夹中有一个名称叫“各村数据”文件夹，这个文件夹中有20多个工作表，每个工作表，就是附件中的那样格式。想要从第五列的第二行开始，每个单元格的身份证号按身份证的规则，进行检查。想要请哪位老师给写个代码。如果不符合身份证号的规则，就复制错误行，放在D盘里有一个“玉米大豆水稻补贴”文件夹，这个文件夹中有一个名称叫“身份证错误”工作表中。

清茶一

你这表里啥数据也没，不道你的意图

安永飞

清茶一 发表于 2024-7-30 20:07
你这表里啥数据也没，不道你的意图

就是按照身份证的规则，把不符合身份证规定的那个单元格的那行数据，挑出来，复制到指定文件夹中。

lcluck2002

要检查哪些呢：
1、身份证号码长度是否是18位或15位
2、前六位区域码与实际的所在区域信息是否对应
3、7-14位数字是否能组成有效的日期，且是否与出生日期一致
4、倒数第二位，与性别是否一致
5、最末位校验码是否正确。

安永飞

lcluck2002 发表于 2024-8-2 14:31
要检查哪些呢：
1、身份证号码长度是否是18位或15位
2、前六位区域码与实际的所在区域信息是否对应

老师说的对，就是这些，如果有不对身份证号的，就复制到指定文件夹中。

安永飞

lcluck2002 发表于 2024-8-2 14:31
要检查哪些呢：
1、身份证号码长度是否是18位或15位
2、前六位区域码与实际的所在区域信息是否对应

Sub CheckIDs()  
    Dim ws As Worksheet  
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名  
    Dim lastRow As Long  
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 找到A列的最后一个非空行  
    Dim i As Long  
    Dim id As String  
    Dim isValid As Boolean  
      
    Dim outputRow As Long  
    outputRow = 1 ' 从B1开始输出不符合条件的身份证号  
      
    For i = 1 To lastRow  
        id = ws.Cells(i, 1).Value ' 读取A列的身份证号  
        isValid = CheckIDValidity(id) ' 调用函数检查身份证号是否有效  
         
        If Not isValid Then  
            ' 如果身份证号不符合条件，则复制到B列  
            ws.Cells(outputRow, 2).Value = id  
            outputRow = outputRow + 1 ' 更新输出行的位置  
        End If  
    Next i  
End Sub  
  
' 检查单个身份证号是否有效的函数  
Function CheckIDValidity(ByVal id As String) As Boolean  
    Dim regex As Object  
    Set regex = CreateObject("VBScript.RegExp")  
    With regex  
        .Pattern = "^(\d{17}[\dXx])$" ' 匹配17位数字加一位数字或X的模式  
        .Global = True  
        .IgnoreCase = False  
        If .Test(id) Then  
            ' 如果匹配，返回True  
            CheckIDValidity = True  
        Else  
            ' 如果不匹配，返回False  
            CheckIDValidity = False  
        End If  
    End With  
End Function




Function CalculateIDCheckDigit(ByVal idPrefix As String) As String  
    ' 确保输入的是17位数字  
    If Len(idPrefix) <> 17 Or Not IsNumeric(idPrefix) Then  
        CalculateIDCheckDigit = "Error: Invalid input"  
        Exit Function  
    End If  
      
    ' 加权因子数组，对应身份证前17位  
    Dim weights() As Integer  
    weights = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)  
      
    ' 校验码对应的字符数组  
    Dim checkChars() As String  
    checkChars = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")  
      
    ' 计算加权和  
    Dim sum As Integer  
    Dim i As Integer  
    For i = 0 To 16  
        sum = sum + Val(Mid(idPrefix, i + 1, 1)) * weights(i)  
    Next i  
      
    ' 计算校验码  
    Dim modValue As Integer  
    modValue = sum Mod 11  
      
    ' 返回校验码  
    CalculateIDCheckDigit = checkChars(modValue)  
End Function

这些代码，都不知怎么写的。

安永飞

就是想要从某列第二行开始检查身份证号的正确性，