Step1:用有道云筆記app錄入文字信息:
備注1:
直接得語音錄入結(jié)果存在大量的錯(cuò)誤,比如說:我們村是"龔"姓,但是直接語音輸入的結(jié)果出現(xiàn)"公"字次數(shù)很多
再比如,輸入“蘄春縣劉河鎮(zhèn)花園村”的容易識(shí)別成“邀請(qǐng)人縣聯(lián)合鎮(zhèn)花園村”
再或者,我想要的是數(shù)字“10”,出現(xiàn)的結(jié)果是“幺零”等等
Step2:將文字信息轉(zhuǎn)入excel表格第一列(A列)
先復(fù)制、粘貼(有道云筆記有安卓版、windows版、網(wǎng)頁版、iso版,我是在安卓設(shè)備上進(jìn)行語音輸入,利用windows版進(jìn)行處理)
運(yùn)行下方代碼的第一部分:
備注2:這里需要先安裝vba模塊(不論微軟還是wps都有這個(gè)模塊,這里推薦國(guó)產(chǎn)的wps):
安裝和使用,不做闡述,百度經(jīng)驗(yàn)上有許多資源。
wps vba模塊下載界面.png
~安裝vba模塊之后,wps軟件界面有一個(gè)隱藏的變化:
安裝成功之后,上圖中,“視圖”菜單下的“宏”將不再是灰色。
Step3:操作下方VBA代碼,實(shí)現(xiàn)信息校正、自動(dòng)填充,異常信息查詢。
備注:異常信息包括,身份證不是以"421126"開頭、身份證中間8位與出生年月不相符、與戶主關(guān)系與性別之間得不符等許多檢驗(yàn)
代碼功能包括三個(gè)部分:(下方會(huì)呈現(xiàn)結(jié)果示意)
(1)對(duì)信息進(jìn)行整合:將語音輸入結(jié)果粘貼到excel的A列,校正其中的錯(cuò)漏信息;
(2)自動(dòng)填充:將A列信息分列、填充到預(yù)定格式(B列:戶主;C列:與戶主關(guān)系等)的表格中;
(3)對(duì)自動(dòng)填充結(jié)果的檢驗(yàn)與校正:標(biāo)注異常結(jié)果;運(yùn)行第二遍,可實(shí)現(xiàn)自動(dòng)校正,并重現(xiàn)檢驗(yàn)。
附錄:大家喜聞樂見的代碼
'Excel vba 代碼人口普查專篇:
作者:龔純健
作用域:劉河鎮(zhèn)花園村人口普查
時(shí)間: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都刪除了;條件語句根本沒運(yùn)行
'難道是因?yàn)?他把字符串中的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年級(jí)", "幼一"
Range("A1:A1000").Replace "幼2年級(jí)", "幼二"
Range("A1:A1000").Replace "幼3年級(jí)", "幼三"
Range("A1:A1000").Replace "幼1", "幼一"
Range("A1:A1000").Replace "幼2", "幼二"
Range("A1:A1000").Replace "幼3", "幼三"
Range("A1:A1000").Replace "小學(xué)1年級(jí)", "小一"
Range("A1:A1000").Replace "小學(xué)2年級(jí)", "小二"
Range("A1:A1000").Replace "小學(xué)3年級(jí)", "小三"
Range("A1:A1000").Replace "小學(xué)4年級(jí)", "小四"
Range("A1:A1000").Replace "小學(xué)5年級(jí)", "小五"
Range("A1:A1000").Replace "小學(xué)6年級(jí)", "小五"
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ā)生混亂,進(jìn)行粗略范圍定位
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), "護(hù)主") > 4 And InStr(Range("A" & i), "護(hù)主") < 10 Then
Range("A" & i).Replace "護(hù)主", "戶主"
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
'針對(duì)三字名字,第8位出現(xiàn)戶或第九位出現(xiàn)主字,認(rè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 "其實(shí)現(xiàn)聊著", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "情人先聊著", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "青縣", "蘄春縣"
Range("A1:A1000").Replace "限流", "縣劉"
Range("A1:A1000").Replace "其實(shí)限流", "蘄春縣劉"
Range("A1:A1000").Replace "實(shí)現(xiàn)流程", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "實(shí)現(xiàn)流鎮(zhèn)", "蘄春縣劉河鎮(zhèn)"
Range("A1:A1000").Replace "其實(shí)縣", "蘄春縣"
Range("A1:A1000").Replace "其實(shí)現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "實(shí)現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "請(qǐng)人縣", "蘄春縣"
Range("A1:A1000").Replace "請(qǐng)至縣", "蘄春縣"
Range("A1:A1000").Replace "旗幟縣", "蘄春縣"
Range("A1:A1000").Replace "求均線", "蘄春縣"
Range("A1:A1000").Replace "請(qǐng)人", "蘄春縣"
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 "及文獻(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "及實(shí)現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "請(qǐng)呈現(xiàn)", "蘄春縣"
Range("A1:A1000").Replace "請(qǐng)實(shí)現(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 "好", "號(hào)"
End Sub
'*****************************************************************
'第二步:信息錄入
'*******************************************************************
Sub excel人口序號(hào)和姓名和民族和戶籍地址()
On Error Resume Next
For i = 2 To 1000
a1 = Sheet1.Cells(i, 1)
'戶號(hào)
Sheet1.Cells(i, 2) = Mid(a1, 1, 3)
'人口序號(hào)
Sheet1.Cells(i, 3) = Mid(a1, 4, 1)
Next
'與戶主關(guān)系
'后邊的戶號(hào)要用到這里邊的內(nèi)容(戶主),所以這個(gè)要前置;
'這里假設(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) = "外孫女" '這里我把"外孫女兒"大大前置,這樣才不會(huì)把這幾個(gè)稱謂搞亂
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
'人口序號(hào)1:與戶主的關(guān)系,依據(jù)戶主序號(hào)為1
For i = 2 To 1000
If Sheet1.Cells(i, 5) = "戶主" Then
Sheet1.Cells(i, 3) = "1"
End If
Next
'人口序號(hào)2:序號(hào)要么為1,要么為上一個(gè)單元格數(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 " ", ""
'戶號(hào)修正1:戶號(hào)應(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
'戶號(hào)修正2:不是戶主,沒有戶號(hào)
For i = 2 To 1000
If Sheet1.Cells(i, 5) <> "戶主" Then
Sheet1.Cells(i, 2) = ""
End If
Next
'民族
For i = 2 To 1000
'默認(rèn)漢族
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), "號(hào)") > 0 Then
Sheet1.Cells(i, 11) = Mid(Range("A" & i), InStr(Range("A" & i), "劉河鎮(zhèn)"), InStr(Range("A" & i), "號(hào)") - 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ī)則是,前邊部分是從縣到村(大到小),后邊部分是從號(hào)到組(小到大)
End If
Next
'身份證號(hào)
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
'身份證號(hào)補(bǔ)充:與上文一樣
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 標(biāo)記()
On Error Resume Next
'戶號(hào)檢驗(yàn):第五列是戶主,但第三列戶號(hào)不是1,標(biāo)紅
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)計(jì)
For i = 2 To 1000
If Sheet1.Cells(i, 1) <> "" Then
Renkou = Renkou + 1
End If
Next
'戶號(hào)統(tǒng)計(jì)
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
'戶號(hào)檢驗(yàn):戶號(hào)為1,對(duì)應(yīng)不是戶主,標(biāo)紅
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
'戶號(hào)檢驗(yàn):不是戶主且戶號(hào)不是空,標(biāo)記為青色
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
'戶號(hào)是否為連續(xù)的自然數(shù)
'戶號(hào)復(fù)制到新位置,第3列、隔5行;同時(shí),在第4列創(chuàng)建自然數(shù)序列
For i = 2 To Renkou
If Sheet1.Cells(i, 2) <> "" Then
BB = BB + 1 'BB為戶號(hào)
Sheet1.Cells(Renkou + 5 + BB, 3) = Val(Sheet1.Cells(i, 2))
End If
Sheet1.Cells(Renkou + 5 + BB, 4) = BB
Next
'判斷兩個(gè)序列是否相等
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
'這里有更簡(jiǎn)便的措施
'性別檢驗(yàn):戶主不是男、兒子不是男等
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
'檢驗(yàn)不能出現(xiàn)2個(gè)連續(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
'出生日期與身份證號(hào):身份證號(hào)中間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
'身份證號(hào):身份證號(hào)不是空格、不包含x,且不是18位數(shù),標(biāo)紅
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列信息校正結(jié)果還是出現(xiàn)一定問題,不過這些都是小問題啦;
A列信息校正.png
(2)信息自動(dòng)填充:
(3)為了避免泄露過多的個(gè)人訊息,第三段代碼就不運(yùn)行和展示了;此外,文中雖有泄露個(gè)人信息,的那絕對(duì)不至于引起民事問題,請(qǐng)相關(guān)人員放心(畢竟,你知道我用的誰來舉例的?——我自己都不知道)。