[已解决]自己改编的身份证验证代码，老是提示“下标越界”

237174864

Sub IDcollect()
Dim Myrow As Integer
'定义所在行
Dim XB As Integer
'定义性别
Dim M As Date
'定义出生年龄
Dim K As Date
'定义时间


For Myrow = 6 To Sheets("两有人员台账").Range("D1048567").End(xlUp).Row《==这一句（用的是excle2013


'计算性别15位和8位
    If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 15 Then
        XB = Right(Sheets("两有人员台账").Range("D" & Myrow), 1) Mod 2
            Sheets("两有人员台账").Range("E" & Myrow) = IIf(XB = 1, "男", "女")
    Else
        If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 18 Then
           XB = Mid(Sheets("两有人员台账").Range("D" & Myrow), 17, 1) Mod 2
               Sheets("两有人员台账").Range("E" & Myrow) = IIf(XB = 1, "男", "女")
        Else
        Sheets("两有人员台账").Range("E" & Myrow) = "身份证错误"
        End If
    End If


'计算出生年月
    If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 15 Then
           Sheets("两有人员台账").Range("F" & Myrow) = "19" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 7, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 9, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2)
    Else
         If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 18 Then
           Sheets("两有人员台账").Range("F" & Myrow) = Mid(Sheets("两有人员台账").Range("D" & Myrow), 7, 4) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 13, 2)
       Else
        Sheets("两有人员台账").Range("F" & Myrow) = "身份证错误"
        End If
    End If

'计算年龄
    If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 15 Then
     If CInt(Mid(Sheets("两有人员台账").Range("D" & Myrow), 9, 2)) > 12 Or CInt(Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2)) > 31 Then
        Sheets("两有人员台账").Range("G" & Myrow) = "身份证错误"
     Else
         M = "19" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 7, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 9, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2)
         K = Mid(Sheets("两有人员台账").Range("D" & Myrow), 9, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2)
       If Date >= K Then
         Sheets("两有人员台账").Range("G" & Myrow) = Year(Date) - Year(M)
       Else
         Sheets("两有人员台账").Range("G" & Myrow) = Year(Date) - Year(M) - 1
       End If
     End If
    Else
       If Len(Sheets("两有人员台账").Range("D" & Myrow)) = 18 Then
        If CInt(Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2)) > 12 Or CInt(Mid(Sheets("两有人员台账").Range("D" & Myrow), 13, 2)) > 31 Then
           Sheets("两有人员台账").Range("G" & Myrow) = "身份证错误"
        Else
         M = Mid(Sheets("两有人员台账").Range("D" & Myrow), 7, 4) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 13, 2)
         K = Mid(Sheets("两有人员台账").Range("D" & Myrow), 11, 2) + "-" + Mid(Sheets("两有人员台账").Range("D" & Myrow), 13, 2)
           If Date >= K Then
                 Sheets("两有人员台账").Range("G" & Myrow) = Year(Date) - Year(M)
           Else
                 Sheets("两有人员台账").Range("G" & Myrow) = Year(Date) - Year(M) - 1
           End If
        End If
       Else
         Sheets("两有人员台账").Range("G" & Myrow) = "身份证错误"
       End If
    End If

'判断是否4050人员
    If Sheets("两有人员台账").Range("E" & Myrow) = "男" Then
       If Sheets("两有人员台账").Range("G" & Myrow) >= 50 Then
         Sheets("两有人员台账").Range("H" & Myrow) = "是"
       Else
         Sheets("两有人员台账").Range("H" & Myrow) = "否"
       End If
    Else
       If Sheets("两有人员台账").Range("E" & Myrow) = "女" Then
          If Sheets("两有人员台账").Range("G" & Myrow) >= 40 Then
            Sheets("两有人员台账").Range("H" & Myrow) = "是"
          Else
            Sheets("两有人员台账").Range("H" & Myrow) = "否"
          End If
       Else
          Sheets("两有人员台账").Range("H" & Myrow) = "无法识别"
       End If
    End If

Next

End Sub

最佳答案

月排行榜 / 总排行榜

我心飞翔410

2014-10-22 17:34

还是你的工作表名称有问题 但是又看不出来 我把工作表的名称复制了过去 运行就OK了

跳转到最佳答案楼层

Excel学徒123

在本地窗口调试找问题

我心飞翔410

For Myrow = 6 To Sheets("两有人员台账").Range("D1048567").End(xlUp).Row 试试
For Myrow = 6 To Sheets("两有人员台账").Cells(Rows.Count, 4).End(xlUp).Row
还有就是 工作表名称正确不

237174864

怎么找都不是好清楚啊

237174864

改了一样的 工作薄名字正确

我心飞翔410

237174864 发表于 2014-10-22 17:16
改了一样的 工作薄名字正确

附件弄上来看看  难不成你的后缀名是xlx

237174864

后缀名是xlsm

237174864

麻烦大神帮忙看看

我心飞翔410

还是你的工作表名称有问题 但是又看不出来 我把工作表的名称复制了过去 运行就OK了

237174864

这都可以 谢谢 大神