从别的文件中摘抄的代码，求老师帮我修改一下，变成可以验证身份证的加载宏

碧水红叶

Private Sub CommandButton9_Click()
    '身份证号过滤

    For rowIndex = 3 To rowMax Step 1
        If ActiveSheet.Cells(rowIndex, 4).Value = "" Then
            Range(Cells(rowIndex, 4), Cells(rowIndex, 4)).Select
            MsgBox "第" & rowIndex & "行身份证号为空,请输入后重新执行"
            Exit Sub
        End If

       Dim arr(3 To 10000)
        Dim t As Integer
        t = 2
        Dim v As Integer
        v = 0
        Dim i As Integer
        For i = 3 To rowMax
            t = t + 1
            arr(t) = Cells(i, 4)
        Next
        If UCase(arr(rowIndex)) = UCase(arr(rowIndex + 1)) Then
        Else
        Dim i2 As Integer
        For i2 = rowMax To rowIndex + 1 Step -1
            If UCase(arr(rowIndex)) = UCase(arr(i2)) Then
                If i2 - rowIndex >= 1 Then
                v = v + 1
                    Range(Cells(i2 - 1 + v, 1), Cells(i2 - 1 + v, 50)).Select
                    Selection.Cut
                    Rows(rowIndex + 1).Insert
                    Range(Cells(rowIndex + 1, 1), Cells(rowIndex + 1, 50)).Select
                    Range(Cells(rowIndex + 1, 1), Cells(rowIndex + 1, 19)).Interior.ColorIndex = 41
                End If

            End If

             Range(Cells(rowIndex, 1), Cells(rowIndex + v, 50)).Select
                 Selection.Sort Key1:=Range("A3"), DataOption1:=xlSortTextAsNumbers, Key2:=Range("A3")

        End If

        Dim temp As String
        temp = Trim(ActiveSheet.Cells(rowIndex, 4).Value)
        Dim count As Integer
        count = Len(temp)

        Dim IsValidIdCard As Boolean
        IsValidIdCard = False
        Dim reg As VBScript_RegExp_55.RegExp

        Set reg = New VBScript_RegExp_55.RegExp
            If CheckBox7 = True Then
        If count = 15 Then  '15位身份证号
            reg.Pattern = "^\d{8}((0\d)|(1[0-2]))((3[01])|([0-2]\d))\d{3}$"
            IsValidIdCard = reg.Test(temp)
        ElseIf count = 18 Then   '18位身份证号
            Dim idate As Date
            Dim strDate As String
            Dim intDate1 As Long
            Dim intDate2 As Long

            strDate = Format(Date, "yyyyMMHH")
            intDate1 = CLng(strDate)

            strDate = Mid(temp, 7, 8)
            intDate2 = CLng(strDate)

            '验证日期是否大于当前日期
            If intDate2 < intDate1 Then
            reg.Pattern = "^\d{6}((19[0-9]\d)|(2\d{3}))((0[1-9])|(1[0-2]))((3[01])||(0[1-9])|([1-2]\d))\d{3}(\d|X|x)$"
            IsValidIdCard = reg.Test(temp)
            Else
            IsValidIdCard = False
            End If

        Else
        IsValidIdCard = False  '不满足18位或15位，验证失败
        End If


            ElseIf CheckBox8 = True Then
    If count = 18 Or count = 10 Or count = 15 Then
     IsValidIdCard = True
      Else
      IsValidIdCard = False
       End If
        End If

        If IsValidIdCard = False Then
            ActiveSheet.Cells(rowIndex, 4).Interior.ColorIndex = 41
            str1 = "1"
            strerror = "1"
        End If
    Next rowIndex
    Application.ScreenUpdating = True
    If str <> "" Then
        MsgBox str
        Exit Sub
    End If

   If strerror = "1" Then
      MsgBox "请修改错误身份证信息!"
      Exit Sub
   End If

   If str1 = "" Then
    MsgBox "执行完毕，文档已经完成按照身份证号进行过滤。"

    Exit Sub
   End If
   End If

  End Sub