如何根据省市县地址查询行政区划编码？

楼主天南地北	Q:如何根据填写的省市县地址来查找所在地的对应行政区划编码？如下图所示，A列为待转换的地址，需要在B列显示对应的行政区划编码，如果无法找到，则显示A列地址 A：按ALT+F11，然后插入模块，录入如下代码即可 Sub 行政区划编码转换() On Error Resume Next Dim str As String, s As String, reg As Object, rng As Range, i As Integer Dim ar(), br(), n As Long, T T = Timer Application.ScreenUpdating = False str = "@北京市\|110000\|北京市市辖区\|110100\|北京市市辖区东城区\|110101\|北京市市辖区西城区\|110102\|北京市市辖区朝阳区\|110105\|北京市市辖区丰台区\|110106\|北京市市辖区石景山区\|110107\|北京市市辖区海淀区\|110108\|北京市市辖区门头沟区\|110109\|北京市市辖区房山区\|110111\|北京市市辖区通州区\|110112\|北京市市辖区顺义区\|110113\|北京市市辖区昌平区\|110114\|北京市市辖区大兴区\|110115\|北京市市辖区怀柔区\|110116\|北京市市辖区平谷区\|110117\|北京市县\|110200\|北京市县密云县\|110228\|北京市县延庆县\|110229\|天津市\|120000\|天津市市辖区\|120100\|天津市市辖区和平区\|120101\|天津市市辖区河东区\|120102\|天津市市辖区河西区\|120103\|天津市市辖区南开区\|120104\|天津市市辖区河北区\|120105\|天津市市辖区红桥区\|120106\|天津市市辖区东丽区\|120110\|天津市市辖区西青区\|120111\|天津市市辖区津南区\|120112\|天津市市辖区北辰区\|120113\|天津市市辖区武清区\|120114\|天津市市辖区" str = str & "宝坻区\|120115\|天津市市辖区滨海新区\|120116\|天津市县\|120200\|天津市县宁河县\|120221\|天津市县静海县\|120223\|天津市县蓟县\|120225\|河北省\|130000\|河北省石家庄市\|130100\|河北省石家庄市市辖区\|130101\|河北省石家庄市长安区\|130102\|河北省石家庄市桥东区\|130103\|河北省石家庄市桥西区\|130104\|河北省石家庄市新华区\|130105\|河北省石家庄市井陉矿区\|130107\|河北省石家庄市裕华区\|130108\|河北省石家庄市井陉县\|130121\|河北省石家庄市正定县\|130123\|河北省石家庄市栾城县\|130124\|河北省石家庄市行唐县\|130125\|河北省石家庄市灵寿县\|130126\|河北省石家庄市高邑县\|130127\|河北省石家庄市深泽县\|130128\|河北省石家庄市赞皇县\|130129\|河北省石家庄市无极县\|130130\|河北省石家庄市平山县\|130131\|河北省石家庄市元氏县\|130132\|河北省石家庄市赵县\|130133\|河北省石家庄市辛集市\|130181\|河北省石家庄市藁城市\|130182\|河北省石家庄市晋州市\|130183\|河北省石家庄市新乐市" 中间删除代码N行，因为str文本太长，请参考附件 str = str & "田地区于田县\|653226\|新疆维吾尔自治区和田地区民丰县\|653227\|新疆维吾尔自治区伊犁哈萨克自治州\|654000\|新疆维吾尔自治区伊犁哈萨克自治州伊宁市\|654002\|新疆维吾尔自治区伊犁哈萨克自治州奎屯市\|654003\|新疆维吾尔自治区伊犁哈萨克自治州伊宁县\|654021\|新疆维吾尔自治区伊犁哈萨克自治州察布查尔锡伯自治县\|654022\|新疆维吾尔自治区伊犁哈萨克自治州霍城县\|654023\|新疆维吾尔自治区伊犁哈萨克自治州巩留县\|654024\|新疆维吾尔自治区伊犁哈萨克自治州新源县\|654025\|新疆维吾尔自治区伊犁哈萨克自治州昭苏县\|654026\|新疆维吾尔自治区伊犁哈萨克自治州特克斯县\|654027\|新疆维吾尔自治区伊犁哈萨克自治州尼勒克县\|654028\|新疆维吾尔自治区塔城地区\|654200\|新疆维吾尔自治区塔城地区塔城市\|654201\|新疆维吾尔自治区塔城地区乌苏市\|654202\|新疆维吾尔自治区塔城地区额敏县\|654221\|新疆维吾尔自治区塔城地区沙湾县\|654223\|新疆维吾尔自治区塔城地区托里县\|654224\|新疆维吾" str = str & "尔自治区塔城地区裕民县\|654225\|新疆维吾尔自治区塔城地区和布克赛尔蒙古自治县\|654226\|新疆维吾尔自治区阿勒泰地区\|654300\|新疆维吾尔自治区阿勒泰地区阿勒泰市\|654301\|新疆维吾尔自治区阿勒泰地区布尔津县\|654321\|新疆维吾尔自治区阿勒泰地区富蕴县\|654322\|新疆维吾尔自治区阿勒泰地区福海县\|654323\|新疆维吾尔自治区阿勒泰地区哈巴河县\|654324\|新疆维吾尔自治区阿勒泰地区青河县\|654325\|新疆维吾尔自治区阿勒泰地区吉木乃县\|654326\|新疆维吾尔自治区自治区直辖县级行政区划\|659000\|新疆维吾尔自治区自治区直辖县级行政区划石河子市\|659001\|新疆维吾尔自治区自治区直辖县级行政区划阿拉尔市\|659002\|新疆维吾尔自治区自治区直辖县级行政区划图木舒克市\|659003\|新疆维吾尔自治区自治区直辖县级行政区划五家渠市\|659004\|台湾省\|710000\|香港特别行政区\|810000\|澳门特别行政区\|820000\|" Set reg = CreateObject("VBScript.RegExp") Set rng = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row) If Not rng Is Nothing Then ar = rng.Value br = ar For n = 1 To UBound(ar) If Len(ar(n, 1)) > 0 Then s = "" If InStr(str, ar(n, 1)) = 0 Then For i = Len(ar(n, 1)) To 1 Step -1 s = Mid(ar(n, 1), i, 1) & "[^\|]?" & s Next i Else s = "[^\|]?" & ar(n, 1) & "[^\|]*?" End If With reg .Global = True .Pattern = s & "\\|(\d{6})" br(n, 1) = .Execute(str)(0).submatches(0) End With End If Next n rng.Offset(0, 1) = br Application.ScreenUpdating = True MsgBox "转换完毕" & Chr(10) & "用时" & Format(Timer - T, "0.00秒") End If End Sub 根据地区查询行政区划编码_by 天南地北.rar
2楼微博评论	博大精深啊
3楼微博评论	\|\| @happy_roger: 博大精深啊
4楼微博评论	没有你玩的高端啊！ \|\| @happy_roger: 博大精深啊
5楼老糊涂	下载学习

楼主天南地北	Q:如何根据填写的省市县地址来查找所在地的对应行政区划编码？如下图所示，A列为待转换的地址，需要在B列显示对应的行政区划编码，如果无法找到，则显示A列地址 A：按ALT+F11，然后插入模块，录入如下代码即可 Sub 行政区划编码转换() On Error Resume Next Dim str As String, s As String, reg As Object, rng As Range, i As Integer Dim ar(), br(), n As Long, T T = Timer Application.ScreenUpdating = False str = "@北京市\|110000\|北京市市辖区\|110100\|北京市市辖区东城区\|110101\|北京市市辖区西城区\|110102\|北京市市辖区朝阳区\|110105\|北京市市辖区丰台区\|110106\|北京市市辖区石景山区\|110107\|北京市市辖区海淀区\|110108\|北京市市辖区门头沟区\|110109\|北京市市辖区房山区\|110111\|北京市市辖区通州区\|110112\|北京市市辖区顺义区\|110113\|北京市市辖区昌平区\|110114\|北京市市辖区大兴区\|110115\|北京市市辖区怀柔区\|110116\|北京市市辖区平谷区\|110117\|北京市县\|110200\|北京市县密云县\|110228\|北京市县延庆县\|110229\|天津市\|120000\|天津市市辖区\|120100\|天津市市辖区和平区\|120101\|天津市市辖区河东区\|120102\|天津市市辖区河西区\|120103\|天津市市辖区南开区\|120104\|天津市市辖区河北区\|120105\|天津市市辖区红桥区\|120106\|天津市市辖区东丽区\|120110\|天津市市辖区西青区\|120111\|天津市市辖区津南区\|120112\|天津市市辖区北辰区\|120113\|天津市市辖区武清区\|120114\|天津市市辖区" str = str & "宝坻区\|120115\|天津市市辖区滨海新区\|120116\|天津市县\|120200\|天津市县宁河县\|120221\|天津市县静海县\|120223\|天津市县蓟县\|120225\|河北省\|130000\|河北省石家庄市\|130100\|河北省石家庄市市辖区\|130101\|河北省石家庄市长安区\|130102\|河北省石家庄市桥东区\|130103\|河北省石家庄市桥西区\|130104\|河北省石家庄市新华区\|130105\|河北省石家庄市井陉矿区\|130107\|河北省石家庄市裕华区\|130108\|河北省石家庄市井陉县\|130121\|河北省石家庄市正定县\|130123\|河北省石家庄市栾城县\|130124\|河北省石家庄市行唐县\|130125\|河北省石家庄市灵寿县\|130126\|河北省石家庄市高邑县\|130127\|河北省石家庄市深泽县\|130128\|河北省石家庄市赞皇县\|130129\|河北省石家庄市无极县\|130130\|河北省石家庄市平山县\|130131\|河北省石家庄市元氏县\|130132\|河北省石家庄市赵县\|130133\|河北省石家庄市辛集市\|130181\|河北省石家庄市藁城市\|130182\|河北省石家庄市晋州市\|130183\|河北省石家庄市新乐市" 中间删除代码N行，因为str文本太长，请参考附件 str = str & "田地区于田县\|653226\|新疆维吾尔自治区和田地区民丰县\|653227\|新疆维吾尔自治区伊犁哈萨克自治州\|654000\|新疆维吾尔自治区伊犁哈萨克自治州伊宁市\|654002\|新疆维吾尔自治区伊犁哈萨克自治州奎屯市\|654003\|新疆维吾尔自治区伊犁哈萨克自治州伊宁县\|654021\|新疆维吾尔自治区伊犁哈萨克自治州察布查尔锡伯自治县\|654022\|新疆维吾尔自治区伊犁哈萨克自治州霍城县\|654023\|新疆维吾尔自治区伊犁哈萨克自治州巩留县\|654024\|新疆维吾尔自治区伊犁哈萨克自治州新源县\|654025\|新疆维吾尔自治区伊犁哈萨克自治州昭苏县\|654026\|新疆维吾尔自治区伊犁哈萨克自治州特克斯县\|654027\|新疆维吾尔自治区伊犁哈萨克自治州尼勒克县\|654028\|新疆维吾尔自治区塔城地区\|654200\|新疆维吾尔自治区塔城地区塔城市\|654201\|新疆维吾尔自治区塔城地区乌苏市\|654202\|新疆维吾尔自治区塔城地区额敏县\|654221\|新疆维吾尔自治区塔城地区沙湾县\|654223\|新疆维吾尔自治区塔城地区托里县\|654224\|新疆维吾" str = str & "尔自治区塔城地区裕民县\|654225\|新疆维吾尔自治区塔城地区和布克赛尔蒙古自治县\|654226\|新疆维吾尔自治区阿勒泰地区\|654300\|新疆维吾尔自治区阿勒泰地区阿勒泰市\|654301\|新疆维吾尔自治区阿勒泰地区布尔津县\|654321\|新疆维吾尔自治区阿勒泰地区富蕴县\|654322\|新疆维吾尔自治区阿勒泰地区福海县\|654323\|新疆维吾尔自治区阿勒泰地区哈巴河县\|654324\|新疆维吾尔自治区阿勒泰地区青河县\|654325\|新疆维吾尔自治区阿勒泰地区吉木乃县\|654326\|新疆维吾尔自治区自治区直辖县级行政区划\|659000\|新疆维吾尔自治区自治区直辖县级行政区划石河子市\|659001\|新疆维吾尔自治区自治区直辖县级行政区划阿拉尔市\|659002\|新疆维吾尔自治区自治区直辖县级行政区划图木舒克市\|659003\|新疆维吾尔自治区自治区直辖县级行政区划五家渠市\|659004\|台湾省\|710000\|香港特别行政区\|810000\|澳门特别行政区\|820000\|" Set reg = CreateObject("VBScript.RegExp") Set rng = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row) If Not rng Is Nothing Then ar = rng.Value br = ar For n = 1 To UBound(ar) If Len(ar(n, 1)) > 0 Then s = "" If InStr(str, ar(n, 1)) = 0 Then For i = Len(ar(n, 1)) To 1 Step -1 s = Mid(ar(n, 1), i, 1) & "[^\|]?" & s Next i Else s = "[^\|]?" & ar(n, 1) & "[^\|]*?" End If With reg .Global = True .Pattern = s & "\\|(\d{6})" br(n, 1) = .Execute(str)(0).submatches(0) End With End If Next n rng.Offset(0, 1) = br Application.ScreenUpdating = True MsgBox "转换完毕" & Chr(10) & "用时" & Format(Timer - T, "0.00秒") End If End Sub 根据地区查询行政区划编码_by 天南地北.rar
2楼微博评论	博大精深啊
3楼微博评论	\|\| @happy_roger: 博大精深啊
4楼微博评论	没有你玩的高端啊！ \|\| @happy_roger: 博大精深啊
5楼老糊涂	下载学习