人口普查用VBA程序

Step1:用有道云笔记app录入文字信息：

文稿的语音输入结果.png

备注1：
直接得语音录入结果存在大量的错误，比如说：我们村是"龚"姓，但是直接语音输入的结果出现"公"字次数很多
再比如，输入“蕲春县刘河镇花园村”的容易识别成“邀请人县联合镇花园村”
再或者，我想要的是数字“10”，出现的结果是“幺零”等等

Step2:将文字信息转入excel表格第一列（A列）

先复制、粘贴（有道云笔记有安卓版、windows版、网页版、iso版，我是在安卓设备上进行语音输入，利用windows版进行处理）

运行下方代码的第一部分：

备注2：这里需要先安装vba模块（不论微软还是wps都有这个模块，这里推荐国产的wps）：
安装和使用，不做阐述，百度经验上有许多资源。


wps vba模块下载界面.png

~安装vba模块之后，wps软件界面有一个隐藏的变化：

安装成功之前.png

安装成功之后，上图中，“视图”菜单下的“宏”将不再是灰色。

安装成功之后.png

Step3:操作下方VBA代码，实现信息校正、自动填充，异常信息查询。

备注：异常信息包括，身份证不是以"421126"开头、身份证中间8位与出生年月不相符、与户主关系与性别之间得不符等许多检验

代码功能包括三个部分：（下方会呈现结果示意）
（1）对信息进行整合：将语音输入结果粘贴到excel的A列，校正其中的错漏信息；
（2）自动填充：将A列信息分列、填充到预定格式（B列：户主；C列：与户主关系等）的表格中；
（3）对自动填充结果的检验与校正：标注异常结果；运行第二遍，可实现自动校正，并重现检验。

附录:大家喜闻乐见的代码

'Excel vba 代码人口普查专篇：
作者：龚纯健
作用域：刘河镇花园村人口普查
时间：2020.6

'第一步：信息输入及其校正

Sub A列初始信息校正()
On Error Resume Next
'前面多余字符串替换
Range("A1:A1000").Replace "开始", ""
Range("A1:A1000").Replace "太史", ""
Range("A1:A1000").Replace "原来", ""
Range("A1:A1000").Replace "但是", ""
Range("A1:A1000").Replace "他是", ""
Range("A1:A1000").Replace "She", ""
Range("A1:A1000").Replace ",", ""
Range("A1:A1000").Replace "，", ""
Range("A1:A1000").Replace "。", ""
Range("A1:A1000").Replace "《", ""
Range("A1:A1000").Replace "》", ""
Range("A1:A1000").Replace "只", ""
Range("A1:A1000").Replace "治", ""

'消除初始的干扰数字
For i = 2 To 1000
If Sheet1.Cells(i, 1) = "" Then
   Sheet1.Rows(i).Delete
End If

If InStr(Range("A" & i), "人家") >= 1 Then
Range("A" & i).Replace "人家", "00"
End If


If InStr(Range("A" & i), "连着") >= 1 Then
Range("A" & i).Replace "连着", "00"
End If

If InStr(Range("A" & i), "那天") >= 1 Then
Range("A" & i).Replace "那天", "00"
End If

If InStr(Range("A" & i), "您的") >= 1 Then
Range("A" & i).Replace "您的", "00"
End If

If InStr(Range("A" & i), "Linda") >= 1 Then
Range("A" & i).Replace "Linda", "00"
End If

If InStr(Range("A" & i), "人力") >= 1 Then
Range("A" & i).Replace "人力", "00"
End If

If InStr(Range("A" & i), "人") >= 1 Then
Range("A" & i).Replace "人", "00"
End If


If InStr(Range("A" & i), "聊") >= 1 Then
Range("A" & i).Replace "聊", "01"
End If

If InStr(Range("A" & i), "辽") >= 1 Then
Range("A" & i).Replace "辽", "01"
End If

If InStr(Range("A" & i), "疗") >= 1 Then
Range("A" & i).Replace "疗", "01"
End If

If InStr(Range("A" & i), "连") >= 1 Then
Range("A" & i).Replace "连", "02"
End If

If InStr(Range("A" & i), "练") >= 1 Then
Range("A" & i).Replace "练", "02"
End If
Next

'数字替换
Range("A1:A1000").Replace "零", "0"
Range("A1:A1000").Replace "陵", "0"
Range("A1:A1000").Replace "令", "0"
Range("A1:A1000").Replace "龄", "0"
Range("A1:A1000").Replace "凌", "0"
Range("A1:A1000").Replace "岭", "0"
Range("A1:A1000").Replace "梁", "0"
Range("A1:A1000").Replace "琳", "0"
Range("A1:A1000").Replace "林", "0"


Range("A1:A1000").Replace "一", "1"
Range("A1:A1000").Replace "幺", "1"
Range("A1:A1000").Replace "邀", "1"
Range("A1:A1000").Replace "要", "1"
Range("A1:A1000").Replace "夭", "1"
Range("A1:A1000").Replace "妖", "1"

Range("A1:A1000").Replace "二", "2"
Range("A1:A1000").Replace "三", "3"
Range("A1:A1000").Replace "四", "4"
Range("A1:A1000").Replace "五", "5"
Range("A1:A1000").Replace "污", "5"

Range("A1:A1000").Replace "六", "6"
Range("A1:A1000").Replace "七", "7"
Range("A1:A1000").Replace "期", "7"
Range("A1:A1000").Replace "八", "8"
Range("A1:A1000").Replace "把", "8"
Range("A1:A1000").Replace "吧", "8"
Range("A1:A1000").Replace "九", "9"
Range("A1:A1000").Replace "十", "10"

Range("A1:A1000").Replace "赛尔", "42"
Range("A1:A1000").Replace "撒", "42"
Range("A1:A1000").Replace "扫", "42"
Range("A1:A1000").Replace "31126", "421126"
Range("A1:A1000").Replace "3126", "421126"
Range("A1:A1000").Replace "42116", "421126"
Range("A1:A1000").Replace "萨尔", "42"
Range("A1:A1000").Replace "萨", "42"

For i = 2 To 1000
If InStr(Range("A" & i), "林1") > 0 Then
Range("A" & i).Replace "林", "0"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "林0") > 0 Then
Range("A" & i).Replace "林", "0"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "你1") > 0 Then
Range("A" & i).Replace "你", "0"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "你0") > 0 Then
Range("A" & i).Replace "你", "0"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "40") > 0 And InStr(Range("A" & i), "40") < 2 Then
Range("A" & i).Replace "4", ""
End If
Next
'不知道为什么,出来的结果是把所有的4都删除了；条件语句根本没运行
'难道是因为,他把字符串中的0当作通配了？

For i = 2 To 1000
If InStr(Range("A" & i), "是") > 0 And InStr(Range("A" & i), "是") <= 2 Then
Range("A" & i).Replace "是", ""
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "史") > 0 And InStr(Range("A" & i), "史") < 2 Then
Range("A" & i).Replace "史", ""
End If
Next

'受教育程度
Range("A1:A1000").Replace "幼儿园小班", "幼小"
Range("A1:A1000").Replace "幼儿园中班", "幼中"
Range("A1:A1000").Replace "幼儿园大班", "幼大"
Range("A1:A1000").Replace "幼儿园", "幼"
Range("A1:A1000").Replace "幼1年级", "幼一"
Range("A1:A1000").Replace "幼2年级", "幼二"
Range("A1:A1000").Replace "幼3年级", "幼三"
Range("A1:A1000").Replace "幼1", "幼一"
Range("A1:A1000").Replace "幼2", "幼二"
Range("A1:A1000").Replace "幼3", "幼三"


Range("A1:A1000").Replace "小学1年级", "小一"
Range("A1:A1000").Replace "小学2年级", "小二"
Range("A1:A1000").Replace "小学3年级", "小三"
Range("A1:A1000").Replace "小学4年级", "小四"
Range("A1:A1000").Replace "小学5年级", "小五"
Range("A1:A1000").Replace "小学6年级", "小五"

Range("A1:A1000").Replace "小1", "小一"
Range("A1:A1000").Replace "小2", "小二"
Range("A1:A1000").Replace "小3", "小三"
Range("A1:A1000").Replace "小4", "小四"
Range("A1:A1000").Replace "小5", "小五"

Range("A1:A1000").Replace "初1", "初一"
Range("A1:A1000").Replace "初2", "初二"
Range("A1:A1000").Replace "初2", "初二"

Range("A1:A1000").Replace "高1", "高一"
Range("A1:A1000").Replace "高2", "高二"
Range("A1:A1000").Replace "高2", "高二"

Range("A1:A1000").Replace "大1", "大一"
Range("A1:A1000").Replace "大2", "大二"
Range("A1:A1000").Replace "大3", "大三"
Range("A1:A1000").Replace "大4", "大四"

'姓名处理
Range("A1:A1000").Replace "宫", "龚"
Range("A1:A1000").Replace "公", "龚"
Range("A1:A1000").Replace "功", "龚"
Range("A1:A1000").Replace "工", "龚"
Range("D1:D1000").Replace "弓", "龚"
Range("D1:D1000").Replace "菜", "蔡"
Range("A1:A1000").Replace "斤", "金"

'与户主关系
'为避免"户主"里边的"hu"与后边"花园村"里边的"花"发生混乱，进行粗略范围定位
For i = 2 To 1000
If InStr(Range("A" & i), "互助") > 4 And InStr(Range("A" & i), "互助") < 10 Then
Range("A" & i).Replace "互助", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "或者") > 4 And InStr(Range("A" & i), "或者") < 10 Then
Range("A" & i).Replace "或者", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "护主") > 4 And InStr(Range("A" & i), "护主") < 10 Then
Range("A" & i).Replace "护主", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "沪") > 4 And InStr(Range("A" & i), "沪") < 10 Then
Range("A" & i).Replace "沪", "户主"
End If
Next

'针对三字名字，第8位出现户或第九位出现主字，认为是户主
For i = 2 To 1000
If InStr(Range("A" & i), "户主") = 0 And InStr(Range("A" & i), "户") = 8 Then
Range("A" & i).Replace "户", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "户主") = 0 And InStr(Range("A" & i), "主") = 9 Then
Range("A" & i).Replace "户", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "葫") > 4 And InStr(Range("A" & i), "葫芦") < 15 Then
Range("A" & i).Replace "葫", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "互") > 4 And InStr(Range("A" & i), "互") < 15 Then
Range("A" & i).Replace "互", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "hoo") > 4 And InStr(Range("A" & i), "hoo") < 15 Then
Range("A" & i).Replace "hoo", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "的") > 4 And InStr(Range("A" & i), "的") < 15 Then
Range("A" & i).Replace "的", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "煮") > 4 And InStr(Range("A" & i), "煮") < 15 Then
Range("A" & i).Replace "煮", "户主"
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "佩") > 5 And InStr(Range("A" & i), "配偶") < 15 Then
Range("A" & i).Replace "佩", "配偶"
End If
Next

Range("A1:A1000").Replace "pale", "配偶"
Range("A1:A1000").Replace "pail", "配偶"
Range("A1:A1000").Replace "Paul", "配偶"
Range("A1:A1000").Replace "配合", "配偶"

Range("A1:A1000").Replace "儿其", "儿媳"
Range("A1:A1000").Replace "儿习", "儿媳"

'居住地址校正
Range("A1:A1000").Replace "其实现聊着", "蕲春县刘河镇"
Range("A1:A1000").Replace "情人先聊着", "蕲春县刘河镇"
Range("A1:A1000").Replace "青县", "蕲春县"
Range("A1:A1000").Replace "限流", "县刘"
Range("A1:A1000").Replace "其实限流", "蕲春县刘"
Range("A1:A1000").Replace "实现流程", "蕲春县刘河镇"
Range("A1:A1000").Replace "实现流镇", "蕲春县刘河镇"
Range("A1:A1000").Replace "其实县", "蕲春县"
Range("A1:A1000").Replace "其实现", "蕲春县"
Range("A1:A1000").Replace "实现", "蕲春县"
Range("A1:A1000").Replace "请人县", "蕲春县"
Range("A1:A1000").Replace "请至县", "蕲春县"
Range("A1:A1000").Replace "旗帜县", "蕲春县"
Range("A1:A1000").Replace "求均线", "蕲春县"
Range("A1:A1000").Replace "请人", "蕲春县"
Range("A1:A1000").Replace "情人", "蕲春县"
Range("A1:A1000").Replace "直线", "蕲春县"
Range("A1:A1000").Replace "情愿", "蕲春县"
Range("A1:A1000").Replace "求县", "蕲春县"
Range("A1:A1000").Replace "呈现", "蕲春县"
Range("A1:A1000").Replace "及文献", "蕲春县"
Range("A1:A1000").Replace "及实现", "蕲春县"
Range("A1:A1000").Replace "请呈现", "蕲春县"
Range("A1:A1000").Replace "请实现", "蕲春县"
Range("A1:A1000").Replace "鸡任县", "蕲春县"
Range("A1:A1000").Replace "鸡呈现", "蕲春县"
Range("A1:A1000").Replace "县见", "县"
Range("A1:A1000").Replace "县先", "县"
Range("A1:A1000").Replace "县线", "县"
Range("A1:A1000").Replace "县现", "县"
Range("A1:A1000").Replace "县件", "县"
Range("A1:A1000").Replace "浏河", "刘河"
Range("A1:A1000").Replace "流河镇", "刘河镇"
Range("A1:A1000").Replace "柳河镇", "刘河镇"
Range("A1:A1000").Replace "聊着镇", "刘河镇"
Range("A1:A1000").Replace "聊着", "刘河镇"
Range("A1:A1000").Replace "聊真", "刘河镇"
Range("A1:A1000").Replace "里河镇", "刘河镇"
Range("A1:A1000").Replace "联合镇", "刘河镇"
Range("A1:A1000").Replace "01着花园村", "刘河镇花园村"
Range("A1:A1000").Replace "01真花园村", "刘河镇花园村"
Range("A1:A1000").Replace "曾任花园村", "刘河镇花园村"
Range("A1:A1000").Replace "留着换成", "刘河镇花园村"
Range("A1:A1000").Replace "留着", "刘河镇"
Range("A1:A1000").Replace "刘珍", "刘河镇"
Range("A1:A1000").Replace "流程", "刘河镇"
Range("A1:A1000").Replace "留镇", "刘河镇"
Range("A1:A1000").Replace "刘镇", "刘河镇"
Range("A1:A1000").Replace "刘盛", "刘河镇"
Range("A1:A1000").Replace "流镇", "刘河镇"
Range("A1:A1000").Replace "刘震", "刘河镇"
Range("A1:A1000").Replace "刘振", "刘河镇"
Range("A1:A1000").Replace "刘式花", "刘河镇花"
Range("A1:A1000").Replace "刘智花", "刘河镇花"
Range("A1:A1000").Replace "刘志花", "刘河镇花"
Range("A1:A1000").Replace "刘智", "刘河镇"
Range("A1:A1000").Replace "刘志华那1组", "刘河镇花园村1组"
Range("A1:A1000").Replace "刘仁", "刘河镇"
Range("A1:A1000").Replace "换成", "花园村"
Range("A1:A1000").Replace "花村", "花园村"
Range("A1:A1000").Replace "缓存", "花园村"
Range("A1:A1000").Replace "还存", "花园村"
Range("A1:A1000").Replace "华村", "花园村"
Range("A1:A1000").Replace "换村", "花园村"
Range("A1:A1000").Replace "寰村", "花园村"
Range("A1:A1000").Replace "欢成", "花园村"
Range("A1:A1000").Replace "华形成", "花园村"
Range("A1:A1000").Replace "化成", "花园村"
Range("A1:A1000").Replace "环村", "花园村"
Range("A1:A1000").Replace "撮", "组"
Range("A1:A1000").Replace "南", "男"
Range("A1:A1000").Replace "难", "男"
Range("G1:G1000").Replace "好", "号"
End Sub

'*****************************************************************

'第二步：信息录入

'*******************************************************************
Sub excel人口序号和姓名和民族和户籍地址()
On Error Resume Next
For i = 2 To 1000
a1 = Sheet1.Cells(i, 1)
'户号
Sheet1.Cells(i, 2) = Mid(a1, 1, 3)
'人口序号
Sheet1.Cells(i, 3) = Mid(a1, 4, 1)
Next


'与户主关系
'后边的户号要用到这里边的内容（户主），所以这个要前置；
'这里假设，A列中的户主全部被找出来了；而且，具有较高的可信度，不是户主的没有混成户主
For i = 2 To 1000
If InStr(Range("A" & i), "户主") > 0 Then
   Sheet1.Cells(i, 5) = "户主"
ElseIf InStr(Range("A" & i), "配偶") > 0 Then
   Sheet1.Cells(i, 5) = "配偶"
ElseIf InStr(Range("A" & i), "父亲") > 0 Then
   Sheet1.Cells(i, 5) = "父亲"
ElseIf InStr(Range("A" & i), "母亲") > 0 Then
   Sheet1.Cells(i, 5) = "母亲"
ElseIf InStr(Range("A" & i), "弟弟") > 0 Then
   Sheet1.Cells(i, 5) = "弟弟"
ElseIf InStr(Range("A" & i), "哥哥") > 0 Then
   Sheet1.Cells(i, 5) = "哥哥"
ElseIf InStr(Range("A" & i), "妹妹") > 0 Then
   Sheet1.Cells(i, 5) = "妹妹"
ElseIf InStr(Range("A" & i), "姐姐") > 0 Then
   Sheet1.Cells(i, 5) = "姐姐"
ElseIf InStr(Range("A" & i), "儿子") > 0 Then
   Sheet1.Cells(i, 5) = "儿子"
ElseIf InStr(Range("A" & i), "儿媳") > 0 Then
   Sheet1.Cells(i, 5) = "儿媳"
ElseIf InStr(Range("A" & i), "外孙女") > 0 And InStr(Range("A" & i), "外孙女") = 0 Then
   Sheet1.Cells(i, 5) = "外孙女"  '这里我把"外孙女儿"大大前置，这样才不会把这几个称谓搞乱
ElseIf InStr(Range("A" & i), "孙女") > 0 And InStr(Range("A" & i), "外") = 0 Then
   Sheet1.Cells(i, 5) = "孙女"
ElseIf InStr(Range("A" & i), "女儿") > 0 Then
   Sheet1.Cells(i, 5) = "女儿"
ElseIf InStr(Range("A" & i), "孙子") > 0 And InStr(Range("A" & i), "外") = 0 Then
   Sheet1.Cells(i, 5) = "孙子"
ElseIf InStr(Range("A" & i), "孙女") > 0 And InStr(Range("A" & i), "外") = 0 Then
   Sheet1.Cells(i, 5) = "孙女"
ElseIf InStr(Range("A" & i), "孙女") > 0 And InStr(Range("A" & i), "外") > 0 Then
   Sheet1.Cells(i, 5) = "孙女"
ElseIf InStr(Range("A" & i), "外孙") > 0 And InStr(Range("A" & i), "孙女") = 0 Then
   Sheet1.Cells(i, 5) = "外孙"
End If
Next



'人口序号1：与户主的关系，依据户主序号为1
For i = 2 To 1000
If Sheet1.Cells(i, 5) = "户主" Then
    Sheet1.Cells(i, 3) = "1"
 End If
Next
'人口序号2:序号要么为1，要么为上一个单元格数字加1
For i = 2 To 1000
If Sheet1.Cells(i, 3) <> "" And Val(Sheet1.Cells(i, 3)) <> 1 Then
  Sheet1.Cells(i, 3) = Str(Val(Sheet1.Cells(i - 1, 3)) + 1)
End If
Next
Range("C2:C1000").Replace " ", ""



'户号修正1：户号应当等于户主出现的次数
For i = 2 To 1000
If Sheet1.Cells(i, 5) = "户主" Then
JJ = JJ + 1
If Val(Sheet1.Cells(i, 2)) = 0 Then
  Sheet1.Cells(i, 2) = Str(JJ)
End If
End If
Next

'户号修正2：不是户主，没有户号
For i = 2 To 1000
If Sheet1.Cells(i, 5) <> "户主" Then
  Sheet1.Cells(i, 2) = ""
End If
Next

'民族
For i = 2 To 1000
'默认汉族
If InStr(Sheet1.Cells(i, 1), "汉族") > 0 Then
Sheet1.Cells(i, 9) = "汉族"
End If
Next

'居住地址
For i = 2 To 1000
If InStr(Range("A" & i), "刘河镇") > 0 And InStr(Range("A" & i), "号") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "刘河镇"), InStr(Range("A" & i), "号") - InStr(Range("A" & i), "刘河镇") + 1)
ElseIf InStr(Range("A" & i), "刘河镇") > 0 And InStr(Range("A" & i), "室") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "刘河镇"), InStr(Range("A" & i), "室") - InStr(Range("A" & i), "刘河镇") + 1)

ElseIf InStr(Range("A" & i), "刘河镇") > 0 And InStr(Range("A" & i), "组") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "刘河镇"), InStr(Range("A" & i), "组") - InStr(Range("A" & i), "刘河镇") + 1)
  
ElseIf InStr(Range("A" & i), "刘河镇") > 0 And InStr(Range("A" & i), "村") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "刘河镇"), InStr(Range("A" & i), "村") - InStr(Range("A" & i), "刘河镇") + 1)

ElseIf InStr(Range("A" & i), "刘河镇") > 0 And InStr(Range("A" & i), "街") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "刘河镇"), InStr(Range("A" & i), "街") - InStr(Range("A" & i), "刘河镇") + 1)

'这里要遵守的规则是，前边部分是从县到村（大到小），后边部分是从号到组（小到大）
End If
Next


'身份证号
For i = 2 To 1000
If InStr(Sheet1.Cells(i, 6), 男) > 0 Or InStr(Sheet1.Cells(i, 6), 女) > 0 Then
Sheet1.Cells(i, 6) = ""
End If
Next

For i = 2 To 1000
If InStr(Range("A" & i), "421126") > 0 Then
Sheet1.Cells(i, 6) = Mid(Range("A" & i), InStr(Range("A" & i), "421126"), 18)
End If
Next

For i = 2 To 1000
If Sheet1.Cells(i, 6) = "" Then
Range("A" & i).Replace "2619", "42112619"
Range("A" & i).Replace "2620", "42112620"
Range("A" & i).Replace "11619", "42112619"
Range("A" & i).Replace "11620", "42112619"
End If
Next


'身份证号补充：与上文一样
For i = 2 To 1000
If InStr(Range("A" & i), "421126") > 0 Then
Sheet1.Cells(i, 6) = Mid(Range("A" & i), InStr(Range("A" & i), "421126"), 18)
End If
Next

'出生日期
For i = 2 To 1000
If InStr(Range("A" & i), "汉族") > 0 Then
Sheet1.Cells(i, 8) = Mid(Range("A" & i), InStr(Range("A" & i), "汉族") - 8, 8)
End If
Next
'性别
For i = 2 To 1000
If InStr(Range("A" & i), "男") > 0 Then
   Sheet1.Cells(i, 7) = "男"
ElseIf InStr(Range("A" & i), "女") > 0 Then
   Sheet1.Cells(i, 7) = "女"
End If
Next

'受教育程度
For i = 2 To 2000
If InStr(Range("A" & i), "幼") > 15 Then
   Sheet1.Cells(i, 15) = Mid(Range("A" & i), InStr(Range("A" & i), "幼"), 2)
End If
If InStr(Range("A" & i), "小") > 15 Then
   Sheet1.Cells(i, 15) = Mid(Range("A" & i), InStr(Range("A" & i), "小"), 2)
End If
If InStr(Range("A" & i), "初") > 15 Then
   Sheet1.Cells(i, 15) = Mid(Range("A" & i), InStr(Range("A" & i), "初"), 2)
End If
If InStr(Range("A" & i), "高") > 15 Then
   Sheet1.Cells(i, 15) = Mid(Range("A" & i), InStr(Range("A" & i), "高"), 2)
End If
If InStr(Range("A" & i), "大") > 15 Then
   Sheet1.Cells(i, 15) = Mid(Range("A" & i), InStr(Range("A" & i), "大"), 2)
End If
If InStr(Range("A" & i), "半文盲") > 15 Then
   Sheet1.Cells(i, 15) = "半文盲"
End If
If InStr(Range("A" & i), "文盲") > 15 And InStr(Range("A" & i), "半文盲") = 0 Then
   Sheet1.Cells(i, 15) = "文盲"
End If
If InStr(Range("A" & i), "本科") > 15 Then
   Sheet1.Cells(i, 15) = "本科"
End If

If InStr(Range("A" & i), "专科") > 15 Then
   Sheet1.Cells(i, 15) = "专科"
End If

If InStr(Range("A" & i), "大专") > 15 Then
   Sheet1.Cells(i, 15) = "大专"
End If
If InStr(Range("A" & i), "中专") > 15 Then
   Sheet1.Cells(i, 15) = "中专"
End If
If InStr(Range("A" & i), "大学") > 15 Then
   Sheet1.Cells(i, 15) = "大学"
End If

If InStr(Range("A" & i), "研究生") > 15 Then
   Sheet1.Cells(i, 15) = "研究生"
End If

Next
End Sub

'********************************************************

'第三步：信息校正
Sub 标记()
On Error Resume Next


'户号检验：第五列是户主，但第三列户号不是1，标红
For i = 1 To 1000
Sheet1.Cells(i, 2).Interior.ColorIndex = 0
Sheet1.Cells(i, 3).Interior.ColorIndex = 0
Sheet1.Cells(i, 4).Interior.ColorIndex = 0
Sheet1.Cells(i, 5).Interior.ColorIndex = 0
Sheet1.Cells(i, 6).Interior.ColorIndex = 0
Sheet1.Cells(i, 7).Interior.ColorIndex = 0
Sheet1.Cells(i, 8).Interior.ColorIndex = 0
Next

'人口统计
For i = 2 To 1000
If Sheet1.Cells(i, 1) <> "" Then
Renkou = Renkou + 1
End If
Next

'户号统计
For i = 2 To Renkou
If Sheet1.Cells(i, 2) <> "" Then
Huhao = Huhao + 1
End If
Next


For i = 2 To Renkou
If Sheet1.Cells(i, 5) = "户主" And Val(Sheet1.Cells(i, 3)) <> 1 Then
  Sheet1.Cells(i, 3).Interior.ColorIndex = 3
  Sheet1.Cells(i, 5).Interior.ColorIndex = 7
End If
Next

'户号检验：户号为1,对应不是户主，标红
For i = 2 To Renkou
If Val(Sheet1.Cells(i, 3)) = 1 And Sheet1.Cells(i, 5) <> "户主" Then
  Sheet1.Cells(i, 3).Interior.ColorIndex = 4
  Sheet1.Cells(i, 5).Interior.ColorIndex = 3
End If
Next

'户号检验：不是户主且户号不是空，标记为青色
For i = 2 To Renkou
If Sheet1.Cells(i, 5) <> "户主" And Sheet1.Cells(i, 2) <> "" Then
  Sheet1.Cells(i, 2).Interior.ColorIndex = 8
End If
Next


'户号是否为连续的自然数
'户号复制到新位置，第3列、隔5行；同时，在第4列创建自然数序列
For i = 2 To Renkou
If Sheet1.Cells(i, 2) <> "" Then
BB = BB + 1  'BB为户号
Sheet1.Cells(Renkou + 5 + BB, 3) = Val(Sheet1.Cells(i, 2))
End If
Sheet1.Cells(Renkou + 5 + BB, 4) = BB
Next

'判断两个序列是否相等
For i = Renkou + 5 To Huhao + Renkou + 5
If Sheet1.Cells(i, 4) <> Sheet1.Cells(i, 3) Then
Sheet1.Cells(i, 4).Interior.ColorIndex = 3
End If
Next

'这里有更简便的措施



'性别检验：户主不是男、儿子不是男等
For i = 2 To Renkou
If Sheet1.Cells(i, 5) = "户主" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "儿子" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "孙子" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "外孙" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "弟弟" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "哥哥" And Sheet1.Cells(i, 7) <> "男" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "配偶" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "儿媳" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "姐姐" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "孙女" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "外孙女" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
If Sheet1.Cells(i, 5) = "妹妹" And Sheet1.Cells(i, 7) <> "女" Then
Sheet1.Cells(i, 7).Interior.ColorIndex = 3
End If
Next

'检验不能出现2个连续的配偶
For i = 2 To Renkou
If Sheet1.Cells(i, 5) = "配偶" And Sheet1.Cells(i + 1, 5) = "配偶" Then
Sheet1.Cells(i, 5).Interior.ColorIndex = 3
End If
Next



'出生日期与身份证号：身份证号中间8位于出生日期
For i = 2 To Renkou
If Mid(Sheet1.Cells(i, 6), 7, 8) <> Sheet1.Cells(i, 8) Then
Sheet1.Cells(i, 8).Interior.ColorIndex = 3
End If
Next

'身份证号：身份证号不是空格、不包含x，且不是18位数，标红
For i = 2 To Renkou
If Sheet1.Cells(i, 6) <> "" And InStr(Sheet1.Cells(i, 6), "x") = 0 Then
If Val(Sheet1.Cells(i, 6)) < 2E+17 Then
Sheet1.Cells(i, 6).Interior.ColorIndex = 3
End If
End If
Next

End Sub

Test:

(1)A列信息校正结果还是出现一定问题，不过这些都是小问题啦；


A列信息校正.png

(2)信息自动填充：

待填充格式.png
自动填充结果示意.png

(3)为了避免泄露过多的个人讯息，第三段代码就不运行和展示了；此外，文中虽有泄露个人信息，的那绝对不至于引起民事问题，请相关人员放心（毕竟，你知道我用的谁来举例的？——我自己都不知道）。

本人镇楼照（猜猜我是谁） .jpg
最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
禁止转载，如需转载请通过简信或评论联系作者。
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 205,033评论 6赞 478
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 87,725评论 2赞 381
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 151,473评论 0赞 338
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 54,846评论 1赞 277
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 63,848评论 5赞 368
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 48,691评论 1赞 282
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 38,053评论 3赞 399
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 36,700评论 0赞 258
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 42,856评论 1赞 300
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,676评论 2赞 323
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,787评论 1赞 333
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 33,430评论 4赞 321
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 39,034评论 3赞 307
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,990评论 0赞 19
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,218评论 1赞 260
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 45,174评论 2赞 352
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 42,526评论 2赞 343