1、文件中的所有数据来自【中华人民共和国民政部】官网：http://www.mca.gov.cn/article/sj/xzqh/2019/

2、由1983年12月至2019年11月的每年一次最新数据组成，但缺少个别数据，请找度娘解决。

3、可满足所有身份证号的籍贯查询。

4、只需采用最新一年的数据，就可用于项目中的省份、地区、县区三级的输入。

5、（针对下列代码而言）【历年原始】表由1983至2018年的数据组成，列名：【区划代码】，字符型，长度6；【区划名称】，字符型，长度15；【区划年份】，整数型。

6、（针对下列代码而言）【本年原始】表由2019年（以后就是当年）的数据组成，表结构同上。

7、（针对下列代码而言）【累计去重】表结构同上，数据由下列代码生成。

8、（针对下列代码而言）【区划简称】表结构同上，并增加【区划简称】列，字符型，长度为15字符，数据由下列代码生成。

9、（针对下列代码而言）在命令窗口执行下列代码。

10、下列代码执行一次后，可以删除【历年原始】表和第一段代码，以后只需先更新【本年原始】表（民政部网当年是逐月更新的），再执行第二段和第三段代码即可。

11、下列第一段代码的依据：因为一个【区划名称】可以对应多个【区划代码】，但一个【区划代码】只能对应一个【区划名称】，故不允许存在相同的【区划代码】，且以最新的为准。

12、注意：因实际上【区划代码】存在一对多的问题，故无法保证都正确。

13、注意：如果【累计去重】表数据与【历年原始】表一致，再执行下列代码，则耗时高达30多分钟，故需按后述的新方法和新代码执行。

    Dim nf As Integer

    Dim drs As List(of DataRow)

    Dim dr As DataRow

    For nf = 2018 To 1984 Step -1

      drs = DataTables("累计去重").Select("[区划年份] = " & nf)

      For Each dr In drs

         DataTables("累计去重").DeleteFor("[区划年份] < " & nf & " And [区划代码] = \'" & dr("区划代码") & "\'")

      Next

    Next

14、新方法和新代码：不会超过3分钟。

Dim f As New Filler

Dim dr,r,r1 As DataRow

Dim dc As DataCol

Dim a As Date = Date.now

Dim b As TimeSpan

\'1-历年累计去重

Dim nf As Integer

Dim drs As List(of DataRow)

f.SourceTable = DataTables("历年原始")

f.SourceCols = "区划代码,区划名称,区划年份"

f.DataTable = DataTables("累计去重")

f.DataCols = "区划代码,区划名称,区划年份"

f.Filter = "区划年份 = 2018"

f.Fill()

For nf = 2017 To 1983 Step -1

    drs = DataTables("历年原始").Select("[区划年份] = " & nf)

    For Each dr In drs

        r = DataTables("累计去重").Find("[区划代码] = \'" & dr("区划代码") & "\'")

        If r Is Nothing Then

            r1 = DataTables("累计去重").AddNew

            For Each dc In DataTables("累计去重").DataCols

                r1(dc.name) = dr(dc.name)

            Next

        End If

    Next

Next

b = Date.now - a

Output.Show(b.TotalSeconds)

\'2-本年累计去重

For Each dr In DataTables("本年原始").DataRows

    r = DataTables("累计去重").Find("[区划代码] = \'" & dr("区划代码") & "\'")

    If r Is Nothing Then

        r1 = DataTables("累计去重").AddNew

        For Each dc In DataTables("累计去重").DataCols

            r1(dc.name) = dr(dc.name)

        Next

    Else

        r("区划年份") = dr("区划年份")

        If r("区划名称") <> dr("区划名称") Then

            r("区划名称") = dr("区划名称")

        End If

    End If

Next

b = Date.now - a

Output.Show(b.TotalSeconds)

\'3-区划名称简称

f = new Filler

f.SourceTable = DataTables("累计去重")

f.SourceCols = "区划代码,区划名称,区划年份,区划名称"

f.DataTable = DataTables("区划简称")

f.DataCols = "区划代码,区划名称,区划年份,区划简称"

f.Fill()

Dim nms() As String = {"自治","满族","蒙古族","蒙古","回族","达斡尔族","朝鲜族","畲族","土家族","苗族","瑶族","侗族","壮族","黎族","仫佬族","毛南族","羌族","彝族","藏族","布依族","水族","傣族","哈尼族","纳西族","拉祜族","景颇族","布朗族","白族","傈僳族","独龙族","怒族","普米族","裕固族","哈萨克族","哈萨克","保安族","东乡族","撒拉族","土族"}

For Each r1 In DataTables("区划简称").DataRows

    \'等于的情况

    If r1("区划简称") = "内蒙古自治区" Then

        r1("区划简称") = "内蒙古"

        Continue For

    End If

    If r1("区划简称") = "广西壮族自治区" Then

        r1("区划简称") = "广西"

        Continue For

    End If

    If r1("区划简称") = "西藏自治区" Then

        r1("区划简称") = "西藏"

        Continue For

    End If

    If r1("区划简称") = "宁夏回族自治区" Then

        r1("区划简称") = "宁夏"

        Continue For

    End If

    If r1("区划简称") = "新疆维吾尔自治区" Then

        r1("区划简称") = "新疆"

        Continue For

    End If

    If r1("区划简称") = "塔什库尔干塔吉克自治县" Then

        r1("区划简称") = "塔什库尔干县"

        Continue For

    End If

    If r1("区划简称") = "东乡族自治县" Then

        r1("区划简称") = "东乡县"

        Continue For

    End If

    If r1("区划简称") = "克孜勒苏柯尔克孜自治州" Then

        r1("区划简称") = "克孜勒苏"

        Continue For

    End If

    \'结尾的情况

    If r1("区划简称").Endswith("省") Then

        r1("区划简称") = r1("区划简称").replace("省","")

        Continue For

    End If

    If r1("区划简称").Endswith("特别行政区") Then

        r1("区划简称") = r1("区划简称").replace("特别行政区","")

        Continue For

    End If

    If r1("区划简称").Endswith("行政区") Then \'此行不能提前

        r1("区划简称") = r1("区划简称").replace("行政区","")

        Continue For

    End If

    If r1("区划简称").Endswith("地区") Then

        r1("区划简称") = r1("区划简称").replace("地区","")

        Continue For

    End If

    If r1("区划简称").Endswith("盟") Then

        r1("区划简称") = r1("区划简称").replace("盟","")

        Continue For

    End If

    If r1("区划简称").Endswith("市") AndAlso r1("区划代码").Endswith("00") Then

        r1("区划简称") = r1("区划简称").replace("市","")

        Continue For

    End If

    \'包含的情况

    If r1("区划简称").Contains("联合") Then

        r1("区划简称") = r1("区划简称").replace("联合","")

        Continue For

    End If

    If r1("区划简称").Contains("各族自治") Then

        r1("区划简称") = r1("区划简称").replace("各族自治","")

        Continue For

    End If

    For Each nm As String In nms

        If r1("区划简称").Contains(nm) Then

            r1("区划简称") = r1("区划简称").replace(nm,"")

        End If

    Next

    \'包含少数民族的结尾

    If r1("区划简称").Endswith("州") Then

        r1("区划简称") = r1("区划简称").replace("州","")

    End If

Next

b = Date.now - a

Output.Show(b.TotalSeconds)

1、Excel有行数限制的。只能利用其他列了，在狐表中拼一下就行了。

2、民政部只提供这种结构，我觉得很好，不管是输入省、省市、省市县都适用。

3、代码有规律，可以自己组合的。

民政局每月都会公布完整最新的行政区域资料，尝试分析下网页，比较简单，可以轻松抓取出来，如下：（供需要的人参考）

dim add as string = “http://www.mca.gov.cn/article/sj/xzqh/2020/2020/202101041104.html”