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


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

主题：[分享]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


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

多谢分享！

 回到顶部
帅哥，在线噢！
wei0769
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：八尾狐 帖子：1822 积分：19495 威望：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


加好友 发短信
等级：小狐 帖子：363 积分：3831 威望：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


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

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

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.06250 秒, 5 次数据查询