Step1:用有道云筆記app錄入文字信息：

文稿的語音輸入結(jié)果.png

備注1：
直接得語音錄入結(jié)果存在大量的錯誤，比如說：我們村是"龔"姓鸠澈，但是直接語音輸入的結(jié)果出現(xiàn)"公"字次數(shù)很多
再比如，輸入“蘄春縣劉河鎮(zhèn)花園村”的容易識別成“邀請人縣聯(lián)合鎮(zhèn)花園村”
再或者截驮，我想要的是數(shù)字“10”笑陈，出現(xiàn)的結(jié)果是“幺零”等等

Step2:將文字信息轉(zhuǎn)入excel表格第一列（A列）

先復(fù)制、粘貼（有道云筆記有安卓版葵袭、windows版涵妥、網(wǎng)頁版、iso版坡锡，我是在安卓設(shè)備上進行語音輸入蓬网，利用windows版進行處理）

運行下方代碼的第一部分：

備注2：這里需要先安裝vba模塊（不論微軟還是wps都有這個模塊，這里推薦國產(chǎn)的wps）：
安裝和使用鹉勒，不做闡述帆锋，百度經(jīng)驗上有許多資源。

wps vba模塊下載界面.png

~安裝vba模塊之后禽额，wps軟件界面有一個隱藏的變化：

安裝成功之前.png

安裝成功之后窟坐，上圖中，“視圖”菜單下的“宏”將不再是灰色绵疲。

安裝成功之后.png

Step3:操作下方VBA代碼哲鸳，實現(xiàn)信息校正、自動填充盔憨，異常信息查詢徙菠。

備注：異常信息包括，身份證不是以"421126"開頭郁岩、身份證中間8位與出生年月不相符婿奔、與戶主關(guān)系與性別之間得不符等許多檢驗

代碼功能包括三個部分：（下方會呈現(xiàn)結(jié)果示意）
（1）對信息進行整合：將語音輸入結(jié)果粘貼到excel的A列，校正其中的錯漏信息问慎；
（2）自動填充：將A列信息分列萍摊、填充到預(yù)定格式（B列：戶主；C列：與戶主關(guān)系等）的表格中如叼；
（3）對自動填充結(jié)果的檢驗與校正：標注異常結(jié)果冰木；運行第二遍，可實現(xiàn)自動校正，并重現(xiàn)檢驗踊沸。

附錄:大家喜聞樂見的代碼

'Excel vba 代碼人口普查專篇：
作者：龔純健
作用域：劉河鎮(zhèn)花園村人口普查
時間：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 "治", ""

'消除初始的干擾數(shù)字
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

'數(shù)字替換
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
'不知道為什么,出來的結(jié)果是把所有的4都刪除了逼龟；條件語句根本沒運行
'難道是因為,他把字符串中的0當(dāng)作通配了评凝？

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 "小學(xué)1年級", "小一"
Range("A1:A1000").Replace "小學(xué)2年級", "小二"
Range("A1:A1000").Replace "小學(xué)3年級", "小三"
Range("A1:A1000").Replace "小學(xué)4年級", "小四"
Range("A1:A1000").Replace "小學(xué)5年級", "小五"
Range("A1:A1000").Replace "小學(xué)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 "斤", "金"

'與戶主關(guān)系
'為避免"戶主"里邊的"hu"與后邊"花園村"里邊的"花"發(fā)生混亂，進行粗略范圍定位
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位出現(xiàn)戶或第九位出現(xiàn)主字奕短，認為是戶主
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 "兒習(xí)", "兒媳"

'居住地址校正
Range("A1:A1000").Replace "其實現(xiàn)聊著", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "情人先聊著", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "青縣", "蘄春縣"
Range("A1:A1000").Replace "限流", "縣劉"
Range("A1:A1000").Replace "其實限流", "蘄春縣劉"
Range("A1:A1000").Replace "實現(xiàn)流程", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "實現(xiàn)流鎮(zhèn)", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "其實縣", "蘄春縣"
Range("A1:A1000").Replace "其實現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "實現(xiàn)", "蘄春縣"
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 "呈現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "及文獻", "蘄春縣"
Range("A1:A1000").Replace "及實現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "請呈現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "請實現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "雞任縣", "蘄春縣"
Range("A1:A1000").Replace "雞呈現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "縣見", "縣"
Range("A1:A1000").Replace "縣先", "縣"
Range("A1:A1000").Replace "縣線", "縣"
Range("A1:A1000").Replace "縣現(xiàn)", "縣"
Range("A1:A1000").Replace "縣件", "縣"
Range("A1:A1000").Replace "瀏河", "劉河"
Range("A1:A1000").Replace "流河鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "柳河鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "聊著鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "聊著", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "聊真", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "里河鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "聯(lián)合鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "01著花園村", "劉河鎮(zhèn)花園村"
Range("A1:A1000").Replace "01真花園村", "劉河鎮(zhèn)花園村"
Range("A1:A1000").Replace "曾任花園村", "劉河鎮(zhèn)花園村"
Range("A1:A1000").Replace "留著換成", "劉河鎮(zhèn)花園村"
Range("A1:A1000").Replace "留著", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉珍", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "流程", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "留鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉盛", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "流鎮(zhèn)", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉震", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉振", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉式花", "劉河鎮(zhèn)花"
Range("A1:A1000").Replace "劉智花", "劉河鎮(zhèn)花"
Range("A1:A1000").Replace "劉志花", "劉河鎮(zhèn)花"
Range("A1:A1000").Replace "劉智", "劉河鎮(zhèn)"
Range("A1:A1000").Replace "劉志華那1組", "劉河鎮(zhèn)花園村1組"
Range("A1:A1000").Replace "劉仁", "劉河鎮(zhèn)"
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 "環(huán)村", "花園村"
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


'與戶主關(guān)系
'后邊的戶號要用到這里邊的內(nèi)容（戶主），所以這個要前置匀钧；
'這里假設(shè)翎碑，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：與戶主的關(guān)系吊圾，依據(jù)戶主序號為1
For i = 2 To 1000
If Sheet1.Cells(i, 5) = "戶主" Then
    Sheet1.Cells(i, 3) = "1"
 End If
Next
'人口序號2:序號要么為1，要么為上一個單元格數(shù)字加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：戶號應(yīng)當(dāng)?shù)扔趹糁鞒霈F(xiàn)的次數(shù)
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), "劉河鎮(zhèn)") > 0 And InStr(Range("A" & i), "號") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "號") - InStr(Range("A" & i), "劉河鎮(zhèn)") + 1)
ElseIf InStr(Range("A" & i), "劉河鎮(zhèn)") > 0 And InStr(Range("A" & i), "室") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "室") - InStr(Range("A" & i), "劉河鎮(zhèn)") + 1)

ElseIf InStr(Range("A" & i), "劉河鎮(zhèn)") > 0 And InStr(Range("A" & i), "組") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "組") - InStr(Range("A" & i), "劉河鎮(zhèn)") + 1)
  
ElseIf InStr(Range("A" & i), "劉河鎮(zhèn)") > 0 And InStr(Range("A" & i), "村") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "村") - InStr(Range("A" & i), "劉河鎮(zhèn)") + 1)

ElseIf InStr(Range("A" & i), "劉河鎮(zhèn)") > 0 And InStr(Range("A" & i), "街") > 0 Then
   Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "街") - InStr(Range("A" & i), "劉河鎮(zhèn)") + 1)

'這里要遵守的規(guī)則是项乒，前邊部分是從縣到村（大到小）梁沧，后邊部分是從號到組（小到大）
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), "大學(xué)") > 15 Then
   Sheet1.Cells(i, 15) = "大學(xué)"
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

'人口統(tǒng)計
For i = 2 To 1000
If Sheet1.Cells(i, 1) <> "" Then
Renkou = Renkou + 1
End If
Next

'戶號統(tǒng)計
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,對應(yīng)不是戶主，標紅
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


'戶號是否為連續(xù)的自然數(shù)
'戶號復(fù)制到新位置垛孔，第3列、隔5行施敢；同時周荐，在第4列創(chuàng)建自然數(shù)序列
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

'檢驗不能出現(xiàn)2個連續(xù)的配偶
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位數(shù)，標紅
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