【数据处理】——利用Excel VBA批量将详细地址转换成省市区三级行政区划

一、背景

导出的excel中只有详细地址，需要将详细地址解析出省市区三级行政区划

收货详细地址

湖北恩施恩施小渡船街道办事处航空大道

四川省成都市武侯石羊场街道办事处蜀绣西路

二、处理思路
1、首先想到的就是直接在excel中进行数据处理，由于数据量很大（几十万级别），因此用Java读取excel再处理的方式难度较大，也不利于非开发人员使用

2、由于详细地址中很多没有省市区相关标志，而且详细地址不规范，因此不能用截取或者正则表达式处理

3、发现LBS开放平台提供相关接口可以解析出省市区，以高德为例，地理编码就可以

URL	https://restapi.amap.com/v3/geocode/geo?parameters
请求方式	GET

4、因此需要在excel中进行编码，饭间聊天，内弟说excel中vba就可以编码，于是一试

三、处理方案

vba编码

Sub 省市区解析()iRows = ActiveSheet.UsedRange.Rows.CountSet objSC = CreateObjectx86("MSScriptControl.ScriptControl")   '在64位版Excel中的处理方法objSC.Language = "JScript"For i = 2 To iRowsptly = Cells(i, "E").Valueaddress1 = Cells(i, "N").ValueAddress = UrlEncode(address1)If ptly = "XXXX" Then                         ' 只处理某种数据If Len(address1) > 10 Then                     ' 只处理详细地址的 用字符长度大于10判断URL = "http://restapi.amap.com/v3/geocode/geo?key=xxxx&address=" + AddressDim http As ObjectSet http = CreateObject("Microsoft.XMLHTTP")     ' 创建 http 对象以发送请求http.Open "GET", URL, False                      ' 设置请求地址http.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"     '设置请求头http.send    '发送请求If http.Status = 200 ThenDim json$                      '定义字符串 jsonjson = http.responseText       '获取相应结果'接下来是解析 jsonstrJSON = "var json=" & jsonobjSC.AddCode (strJSON)        '将 json 由字符串解析为对象Dim geocodesgeocodes = objSC.Eval("json.geocodes")If geocodes <> "" ThenDim province$province = objSC.Eval("json.geocodes[0].province")If province <> "" ThenCells(i, "N").Value = objSC.Eval("json.geocodes[0].province")   '将省填入 Excel 表格Cells(i, "O").Value = objSC.Eval("json.geocodes[0].city")   '将市填入 Excel 表格Cells(i, "P").Value = objSC.Eval("json.geocodes[0].district")   '将区填入 Excel 表格End IfEnd IfEnd IfEnd IfEnd IfNext
End SubFunction CreateObjectx86(Optional sProgID, Optional bClose = False)Static oWnd As ObjectDim bRunning As Boolean#If Win64 ThenbRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0If bClose ThenIf bRunning Then oWnd.CloseExit FunctionEnd IfIf Not bRunning ThenSet oWnd = CreateWindow()oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"End IfSet CreateObjectx86 = oWnd.CreateObjectx86(sProgID)#ElseSet CreateObjectx86 = CreateObject("MSScriptControl.ScriptControl")#End If
End FunctionFunction CreateWindow()Dim sSignature, oShellWnd, oProcOn Error Resume NextsSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""about:<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, FalseDoFor Each oShellWnd In CreateObject("Shell.Application").WindowsSet CreateWindow = oShellWnd.GetProperty(sSignature)If Err.Number = 0 Then Exit FunctionErr.ClearNextLoop
End FunctionFunction UrlEncode(ByRef szString As String) As StringDim szChar   As StringDim szTemp   As StringDim szCode   As StringDim szHex    As StringDim szBin    As StringDim iCount1  As IntegerDim iCount2  As IntegerDim iStrLen1 As IntegerDim iStrLen2 As IntegerDim lResult  As LongDim lAscVal  As LongszString = Trim$(szString)iStrLen1 = Len(szString)For iCount1 = 1 To iStrLen1szChar = Mid$(szString, iCount1, 1)lAscVal = AscW(szChar)If lAscVal >= &H0 And lAscVal <= &HFF ThenIf (lAscVal >= &H30 And lAscVal <= &H39) Or _(lAscVal >= &H41 And lAscVal <= &H5A) Or _(lAscVal >= &H61 And lAscVal <= &H7A) ThenszCode = szCode & szCharElseszCode = szCode & "%" & Hex(AscW(szChar))End IfElseszHex = Hex(AscW(szChar))iStrLen2 = Len(szHex)For iCount2 = 1 To iStrLen2szChar = Mid$(szHex, iCount2, 1)Select Case szCharCase Is = "0"szBin = szBin & "0000"Case Is = "1"szBin = szBin & "0001"Case Is = "2"szBin = szBin & "0010"Case Is = "3"szBin = szBin & "0011"Case Is = "4"szBin = szBin & "0100"Case Is = "5"szBin = szBin & "0101"Case Is = "6"szBin = szBin & "0110"Case Is = "7"szBin = szBin & "0111"Case Is = "8"szBin = szBin & "1000"Case Is = "9"szBin = szBin & "1001"Case Is = "A"szBin = szBin & "1010"Case Is = "B"szBin = szBin & "1011"Case Is = "C"szBin = szBin & "1100"Case Is = "D"szBin = szBin & "1101"Case Is = "E"szBin = szBin & "1110"Case Is = "F"szBin = szBin & "1111"Case ElseEnd SelectNext iCount2szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)For iCount2 = 1 To 24If Mid$(szTemp, iCount2, 1) = "1" ThenlResult = lResult + 1 * 2 ^ (24 - iCount2)Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)End IfNext iCount2szTemp = Hex(lResult)szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)End IfszBin = vbNullStringlResult = 0Next iCount1UrlEncode = szCodeEnd Function

处理后效

收货省份	收货城市	收货区县	收货详细地址
湖北省	恩施土家族苗族自治州	恩施市	湖北恩施恩施小渡船街道办事处航空大道
四川省	成都市	武侯区	四川省成都市武侯石羊场街道办事处蜀绣西路

四、总结

1、之前听说会用excel的人都很牛X，还有点不信，现在感觉他们确实牛

2、有些事情去做了，才发现很有意思

3、算是作为数据分析的一个开端吧，以此为记

【数据处理】——利用Excel VBA批量将详细地址转换成省市区三级行政区划相关推荐

利用Excel VBA批量计算长时间序列植被物候动态阈值（逐像元）
本文演示利用Excel VBA编程实现多期栅格数据,逐像元计算物候参数:生长季始期(SOS).生长季末期(EOS)和生长季长度(LOS),计算过程速度快! 说明: (1)利用Raster to Poi ...
利用Excel VBA批量计算气象数据多个台站多年来春季和冬季降水量和平均气温
气象数据是地理数据的重要组成部分,存储量虽然不大,但是处理过程非常繁琐,长时序数据更不用说.本文总结了一个气象数据的基本处理方法. 如下图所示,气象数据的排列格式是区站号→年→月→降水量→平均气温,时 ...
如何利用Excel快速批量创建文件夹
今天跟大家分享一下如何利用Excel快速批量创建文件夹 1.打开Excel 2.录入要创建的文件夹名称 3.然后录入要创建文件夹的地址 4.接着我们将这两列数据合并并选中单元格区域 5.然后点击下图选 ...
利用Excel VBA SQL做特殊文件浏览器
1.利用JamShellBrowser for ActiveX '转载请注明:本文来自:Excel吧 (www.excelba.com) 详细出处参考:http://www.excelba.com/A ...
Excel转Word，Excel导出Word，利用Excel表批量生成Word文档，邮件合并进阶版
单击播放视频教材利用Excel数据批量生成Word文档升级版,Excel转W 01需求概述假设有图1所示的数据,需要批量生成WORD成绩通知单,通知单必须遵循图2的样式. (案例中的姓名.学校名称 ...
收货地址，模糊详细地址，自动转换成省市区街道，并保存到Excel工具
收货地址,模糊详细地址,自动转换成省市区街道,并保存到Excel工具. 文件模板为: 地址自动转换成省市区街道并保存到Excel文件: 使用说明: 1.双击start.bat,打开工具,选择类似于&l ...
【收藏】Python利用Excel+模板批量生成word文件
Python利用Excel+模板批量生成word文件最近帮朋友批量生成小区业主物业费未缴的律师函.朋友那有物业那边的表格数据,包括楼栋-房间号.业主姓名.欠费日期.欠款金额等信息.目的是需要将这些表 ...
EXCEL中用TEXT函数将文本转换成日期
分享一下我老师大神的人工智能教程!零基础,通俗易懂!http://blog.csdn.net/jiangjunshow 也欢迎大家转载本篇文章.分享知识,造福人民,实现我们中华民族伟大复兴! EXCE ...
谷歌浏览器地址转换成二维码的插件，只需几行代码即可实现
谷歌浏览器插件,是利用javascript进行编写的.具体代码参考在github里面,这是本人简单编写的一个谷歌浏览器地址转换成二维码的插件,里面的代码思路本文暂时不做解析,只是介绍如何使用这个插件. ...
EXCEL数字前补零且转换成文本型
EXCEL数字前补零且转换成文本型方法一.使用公式="0"&A2,只能根据需要补零: 方法二.使用公式＝REPT(0,8-LEN(A2))&A2, 自动为数值补 ...

【数据处理】——利用Excel VBA批量将详细地址转换成省市区三级行政区划

【数据处理】——利用Excel VBA批量将详细地址转换成省市区三级行政区划相关推荐

最新文章

热门文章