Foxtable(狐表)用户栏目专家坐堂 → [分享]1983-2019年行政区划代码(即狐表自带的身份证籍贯编码)


  共有6087人关注过本帖树形打印复制链接

主题:[分享]1983-2019年行政区划代码(即狐表自带的身份证籍贯编码)

帅哥哟,离线,有人找我吗?
shenyl0211
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:977 积分:6835 威望:0 精华:0 注册:2012/4/2 21:49:00
[分享]1983-2019年行政区划代码(即狐表自带的身份证籍贯编码)  发帖心情 Post By:2019/12/10 13:39:00 [显示全部帖子]

网上关于行政区划代码(即狐表自带的身份证籍贯编码)Excel版本、word版本、PDF版本很多,根本不知道是否够用、没错,且下载往往需要付费,所以只能自己下载整理。为了便于补充和完善以后的数据,编写了一段可在命令窗口执行的数据整理代码。

Excel格式下载:
 下载信息  [文件大小:   下载次数: ]
点击浏览该文件:行政区划代码.zip


说明:

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)

[此贴子已经被作者于2020/4/14 23:23:10编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
shenyl0211
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:977 积分:6835 威望:0 精华:0 注册:2012/4/2 21:49:00
  发帖心情 Post By:2020/4/14 21:43:00 [显示全部帖子]

1、Excel有行数限制的。只能利用其他列了,在狐表中拼一下就行了。
2、民政部只提供这种结构,我觉得很好,不管是输入省、省市、省市县都适用。
3、代码有规律,可以自己组合的。
[此贴子已经被作者于2020/4/14 23:23:27编辑过]

 回到顶部