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


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

主题:[分享]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编辑过]

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


加好友 发短信
等级:超级版主 帖子:105470 积分:536335 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/10 14:12:00 [只看该作者]

多谢分享!

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


加好友 发短信
等级:八尾狐 帖子:1814 积分:19186 威望:0 精华:0 注册:2013/4/10 14:38:00
  发帖心情 Post By:2020/2/21 17:40:00 [只看该作者]

谢谢分享


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


加好友 发短信
等级:四尾狐 帖子:855 积分:6402 威望:0 精华:0 注册:2017/11/21 21:31:00
  发帖心情 Post By:2020/4/7 0:19:00 [只看该作者]

这个的Excel里的数据与代码写的数据名称不是那么回事,怎么用?还有就是,Excel表中的省、市、县是不连的,即名称只列出了如“北京市”或“海淀区”,不是“北京市海淀区”,还需要合成“市+县”。能否更完整的?谢谢赐教
[此贴子已经被作者于2020/4/7 0:23:16编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
shenyl0211
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | 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编辑过]

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


加好友 发短信
等级:小狐 帖子:361 积分:3804 威望:0 精华:0 注册:2012/4/16 20:20:00
  发帖心情 Post By:2021/4/30 14:47:00 [只看该作者]

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

dim add as string = “http://www.mca.gov.cn/article/sj/xzqh/2020/2020/202101041104.html”
Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate(add)
Do Until web.ReadyState = 4
    Application.DoEvents
Loop
'取数据
Dim tbl As System.Windows.Forms.HtmlElement
Dim ss As String
tbl = web.Document.GetElementsByTagName("table")(0)
Dim trs As object = tbl.GetElementsByTagName("tr")
For i1 As Integer = 3 To trs.count -1
    Dim td1 As object = trs(i1).GetElementsByTagName("td")(1)
    Dim sd1 As String = td1.innertext
    Dim td2 As object = trs(i1).GetElementsByTagName("td")(2)
    Dim sd2 As String = td2.innertext
    sd1 = sd1.Replace(" ","")
    sd2 = sd2.Replace(" ","")
    ss = ss & "|" & sd1 & "-" & sd2
    If sd2 = "澳门特别行政区" Then
        Exit For
    End If
Next
ss = ss.Trim("|")
FileSys.WriteAllText(ProjectPath &  "data\行政区域.Txt",ss,false)
[此贴子已经被作者于2021/4/30 15:07:02编辑过]

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


加好友 发短信
等级:小狐 帖子:324 积分:2504 威望:0 精华:0 注册:2020/3/2 23:15:00
  发帖心情 Post By:2021/5/28 20:36:00 [只看该作者]

请教一下这个代码是什么意思,怎么用呢?

 回到顶部